summaryrefslogtreecommitdiff
path: root/body
diff options
context:
space:
mode:
Diffstat (limited to 'body')
-rw-r--r--body/c_fl.cpp134
-rw-r--r--body/c_fl.h72
-rw-r--r--body/c_fl_adjuster.cpp99
-rw-r--r--body/c_fl_adjuster.h29
-rw-r--r--body/c_fl_ask.cpp140
-rw-r--r--body/c_fl_ask.h50
-rw-r--r--body/c_fl_bitmap.cpp51
-rw-r--r--body/c_fl_bitmap.h29
-rw-r--r--body/c_fl_bmp_image.cpp22
-rw-r--r--body/c_fl_bmp_image.h20
-rw-r--r--body/c_fl_box.cpp72
-rw-r--r--body/c_fl_box.h25
-rw-r--r--body/c_fl_browser.cpp448
-rw-r--r--body/c_fl_browser.h102
-rw-r--r--body/c_fl_browser_.cpp392
-rw-r--r--body/c_fl_browser_.h83
-rw-r--r--body/c_fl_button.cpp133
-rw-r--r--body/c_fl_button.h42
-rw-r--r--body/c_fl_cairo_window.cpp98
-rw-r--r--body/c_fl_cairo_window.h27
-rw-r--r--body/c_fl_chart.cpp151
-rw-r--r--body/c_fl_chart.h50
-rw-r--r--body/c_fl_check_browser.cpp336
-rw-r--r--body/c_fl_check_browser.h61
-rw-r--r--body/c_fl_check_button.cpp83
-rw-r--r--body/c_fl_check_button.h29
-rw-r--r--body/c_fl_choice.cpp82
-rw-r--r--body/c_fl_choice.h29
-rw-r--r--body/c_fl_clock.cpp72
-rw-r--r--body/c_fl_clock.h25
-rw-r--r--body/c_fl_clock_output.cpp111
-rw-r--r--body/c_fl_clock_output.h35
-rw-r--r--body/c_fl_color_chooser.cpp127
-rw-r--r--body/c_fl_color_chooser.h46
-rw-r--r--body/c_fl_copy_surface.cpp55
-rw-r--r--body/c_fl_copy_surface.h31
-rw-r--r--body/c_fl_counter.cpp120
-rw-r--r--body/c_fl_counter.h38
-rw-r--r--body/c_fl_dial.cpp119
-rw-r--r--body/c_fl_dial.h33
-rw-r--r--body/c_fl_display_device.cpp29
-rw-r--r--body/c_fl_display_device.h23
-rw-r--r--body/c_fl_double_window.cpp114
-rw-r--r--body/c_fl_double_window.h35
-rw-r--r--body/c_fl_draw.cpp447
-rw-r--r--body/c_fl_draw.h137
-rw-r--r--body/c_fl_error.cpp98
-rw-r--r--body/c_fl_error.h27
-rw-r--r--body/c_fl_event.cpp194
-rw-r--r--body/c_fl_event.h66
-rw-r--r--body/c_fl_file_browser.cpp331
-rw-r--r--body/c_fl_file_browser.h61
-rw-r--r--body/c_fl_file_chooser.cpp340
-rw-r--r--body/c_fl_file_chooser.h105
-rw-r--r--body/c_fl_file_input.cpp97
-rw-r--r--body/c_fl_file_input.h34
-rw-r--r--body/c_fl_filename.cpp127
-rw-r--r--body/c_fl_filename.h39
-rw-r--r--body/c_fl_fill_dial.cpp74
-rw-r--r--body/c_fl_fill_dial.h24
-rw-r--r--body/c_fl_fill_slider.cpp74
-rw-r--r--body/c_fl_fill_slider.h24
-rw-r--r--body/c_fl_float_input.cpp67
-rw-r--r--body/c_fl_float_input.h24
-rw-r--r--body/c_fl_gif_image.cpp22
-rw-r--r--body/c_fl_gif_image.h20
-rw-r--r--body/c_fl_gl_window.cpp191
-rw-r--r--body/c_fl_gl_window.h61
-rw-r--r--body/c_fl_graphics_driver.cpp63
-rw-r--r--body/c_fl_graphics_driver.h32
-rw-r--r--body/c_fl_group.cpp193
-rw-r--r--body/c_fl_group.h59
-rw-r--r--body/c_fl_help_dialog.cpp105
-rw-r--r--body/c_fl_help_dialog.h47
-rw-r--r--body/c_fl_help_view.cpp193
-rw-r--r--body/c_fl_help_view.h58
-rw-r--r--body/c_fl_hold_browser.cpp265
-rw-r--r--body/c_fl_hold_browser.h48
-rw-r--r--body/c_fl_hor_fill_slider.cpp74
-rw-r--r--body/c_fl_hor_fill_slider.h24
-rw-r--r--body/c_fl_hor_nice_slider.cpp74
-rw-r--r--body/c_fl_hor_nice_slider.h24
-rw-r--r--body/c_fl_hor_value_slider.cpp74
-rw-r--r--body/c_fl_hor_value_slider.h24
-rw-r--r--body/c_fl_horizontal_slider.cpp74
-rw-r--r--body/c_fl_horizontal_slider.h24
-rw-r--r--body/c_fl_image.cpp142
-rw-r--r--body/c_fl_image.h52
-rw-r--r--body/c_fl_image_surface.cpp55
-rw-r--r--body/c_fl_image_surface.h31
-rw-r--r--body/c_fl_input.cpp82
-rw-r--r--body/c_fl_input.h29
-rw-r--r--body/c_fl_input_.cpp249
-rw-r--r--body/c_fl_input_.h77
-rw-r--r--body/c_fl_input_choice.cpp151
-rw-r--r--body/c_fl_input_choice.h50
-rw-r--r--body/c_fl_int_input.cpp67
-rw-r--r--body/c_fl_int_input.h24
-rw-r--r--body/c_fl_jpeg_image.cpp26
-rw-r--r--body/c_fl_jpeg_image.h21
-rw-r--r--body/c_fl_label.cpp95
-rw-r--r--body/c_fl_label.h39
-rw-r--r--body/c_fl_light_button.cpp67
-rw-r--r--body/c_fl_light_button.h24
-rw-r--r--body/c_fl_line_dial.cpp74
-rw-r--r--body/c_fl_line_dial.h24
-rw-r--r--body/c_fl_menu.cpp300
-rw-r--r--body/c_fl_menu.h87
-rw-r--r--body/c_fl_menu_bar.cpp67
-rw-r--r--body/c_fl_menu_bar.h24
-rw-r--r--body/c_fl_menu_button.cpp90
-rw-r--r--body/c_fl_menu_button.h32
-rw-r--r--body/c_fl_menu_window.cpp106
-rw-r--r--body/c_fl_menu_window.h36
-rw-r--r--body/c_fl_menuitem.cpp194
-rw-r--r--body/c_fl_menuitem.h66
-rw-r--r--body/c_fl_multi_browser.cpp265
-rw-r--r--body/c_fl_multi_browser.h48
-rw-r--r--body/c_fl_multiline_input.cpp67
-rw-r--r--body/c_fl_multiline_input.h24
-rw-r--r--body/c_fl_multiline_output.cpp67
-rw-r--r--body/c_fl_multiline_output.h24
-rw-r--r--body/c_fl_nice_slider.cpp74
-rw-r--r--body/c_fl_nice_slider.h24
-rw-r--r--body/c_fl_output.cpp67
-rw-r--r--body/c_fl_output.h26
-rw-r--r--body/c_fl_overlay_window.cpp116
-rw-r--r--body/c_fl_overlay_window.h36
-rw-r--r--body/c_fl_pack.cpp78
-rw-r--r--body/c_fl_pack.h28
-rw-r--r--body/c_fl_paged_device.cpp154
-rw-r--r--body/c_fl_paged_device.h54
-rw-r--r--body/c_fl_pixmap.cpp58
-rw-r--r--body/c_fl_pixmap.h32
-rw-r--r--body/c_fl_png_image.cpp26
-rw-r--r--body/c_fl_png_image.h21
-rw-r--r--body/c_fl_pnm_image.cpp21
-rw-r--r--body/c_fl_pnm_image.h20
-rw-r--r--body/c_fl_positioner.cpp166
-rw-r--r--body/c_fl_positioner.h49
-rw-r--r--body/c_fl_postscript_file_device.cpp125
-rw-r--r--body/c_fl_postscript_file_device.h47
-rw-r--r--body/c_fl_preferences.cpp233
-rw-r--r--body/c_fl_preferences.h86
-rw-r--r--body/c_fl_printer.cpp259
-rw-r--r--body/c_fl_printer.h85
-rw-r--r--body/c_fl_progress.cpp94
-rw-r--r--body/c_fl_progress.h32
-rw-r--r--body/c_fl_radio_button.cpp67
-rw-r--r--body/c_fl_radio_button.h24
-rw-r--r--body/c_fl_radio_light_button.cpp67
-rw-r--r--body/c_fl_radio_light_button.h24
-rw-r--r--body/c_fl_radio_round_button.cpp68
-rw-r--r--body/c_fl_radio_round_button.h24
-rw-r--r--body/c_fl_repeat_button.cpp74
-rw-r--r--body/c_fl_repeat_button.h27
-rw-r--r--body/c_fl_return_button.cpp67
-rw-r--r--body/c_fl_return_button.h24
-rw-r--r--body/c_fl_rgb_image.cpp78
-rw-r--r--body/c_fl_rgb_image.h36
-rw-r--r--body/c_fl_roller.cpp74
-rw-r--r--body/c_fl_roller.h24
-rw-r--r--body/c_fl_round_button.cpp67
-rw-r--r--body/c_fl_round_button.h24
-rw-r--r--body/c_fl_round_clock.cpp67
-rw-r--r--body/c_fl_round_clock.h24
-rw-r--r--body/c_fl_screen.cpp84
-rw-r--r--body/c_fl_screen.h38
-rw-r--r--body/c_fl_scroll.cpp104
-rw-r--r--body/c_fl_scroll.h37
-rw-r--r--body/c_fl_scrollbar.cpp112
-rw-r--r--body/c_fl_scrollbar.h36
-rw-r--r--body/c_fl_secret_input.cpp67
-rw-r--r--body/c_fl_secret_input.h24
-rw-r--r--body/c_fl_select_browser.cpp264
-rw-r--r--body/c_fl_select_browser.h48
-rw-r--r--body/c_fl_shared_image.cpp100
-rw-r--r--body/c_fl_shared_image.h42
-rw-r--r--body/c_fl_simple_counter.cpp74
-rw-r--r--body/c_fl_simple_counter.h24
-rw-r--r--body/c_fl_single_window.cpp94
-rw-r--r--body/c_fl_single_window.h33
-rw-r--r--body/c_fl_slider.cpp128
-rw-r--r--body/c_fl_slider.h35
-rw-r--r--body/c_fl_spinner.cpp175
-rw-r--r--body/c_fl_spinner.h56
-rw-r--r--body/c_fl_static.cpp305
-rw-r--r--body/c_fl_static.h109
-rw-r--r--body/c_fl_surface_device.cpp58
-rw-r--r--body/c_fl_surface_device.h28
-rw-r--r--body/c_fl_sys_menu_bar.cpp158
-rw-r--r--body/c_fl_sys_menu_bar.h50
-rw-r--r--body/c_fl_tabs.cpp111
-rw-r--r--body/c_fl_tabs.h35
-rw-r--r--body/c_fl_text_buffer.cpp296
-rw-r--r--body/c_fl_text_buffer.h100
-rw-r--r--body/c_fl_text_display.cpp339
-rw-r--r--body/c_fl_text_display.h107
-rw-r--r--body/c_fl_text_editor.cpp398
-rw-r--r--body/c_fl_text_editor.h116
-rw-r--r--body/c_fl_tile.cpp78
-rw-r--r--body/c_fl_tile.h28
-rw-r--r--body/c_fl_tiled_image.cpp64
-rw-r--r--body/c_fl_tiled_image.h33
-rw-r--r--body/c_fl_toggle_button.cpp67
-rw-r--r--body/c_fl_toggle_button.h24
-rw-r--r--body/c_fl_tooltip.cpp131
-rw-r--r--body/c_fl_tooltip.h45
-rw-r--r--body/c_fl_valuator.cpp170
-rw-r--r--body/c_fl_valuator.h48
-rw-r--r--body/c_fl_value_input.cpp148
-rw-r--r--body/c_fl_value_input.h50
-rw-r--r--body/c_fl_value_output.cpp112
-rw-r--r--body/c_fl_value_output.h36
-rw-r--r--body/c_fl_value_slider.cpp101
-rw-r--r--body/c_fl_value_slider.h32
-rw-r--r--body/c_fl_widget.cpp400
-rw-r--r--body/c_fl_widget.h116
-rw-r--r--body/c_fl_window.cpp249
-rw-r--r--body/c_fl_window.h76
-rw-r--r--body/c_fl_wizard.cpp106
-rw-r--r--body/c_fl_wizard.h32
-rw-r--r--body/c_fl_xbm_image.cpp22
-rw-r--r--body/c_fl_xbm_image.h20
-rw-r--r--body/c_fl_xpm_image.cpp22
-rw-r--r--body/c_fl_xpm_image.h20
-rw-r--r--body/fltk-asks.adb659
-rw-r--r--body/fltk-devices-graphics.adb171
-rw-r--r--body/fltk-devices-surface-copy.adb156
-rw-r--r--body/fltk-devices-surface-display.adb118
-rw-r--r--body/fltk-devices-surface-image.adb171
-rw-r--r--body/fltk-devices-surface-paged-postscript.adb505
-rw-r--r--body/fltk-devices-surface-paged-printers.adb915
-rw-r--r--body/fltk-devices-surface-paged.adb538
-rw-r--r--body/fltk-devices-surface.adb180
-rw-r--r--body/fltk-draw.adb1897
-rw-r--r--body/fltk-environment.adb1089
-rw-r--r--body/fltk-errors.adb101
-rw-r--r--body/fltk-event.adb696
-rw-r--r--body/fltk-file_choosers.adb1308
-rw-r--r--body/fltk-filenames.adb492
-rw-r--r--body/fltk-help_dialogs.adb361
-rw-r--r--body/fltk-images-bitmaps-xbm.adb72
-rw-r--r--body/fltk-images-bitmaps.adb181
-rw-r--r--body/fltk-images-pixmaps-gif.adb67
-rw-r--r--body/fltk-images-pixmaps-xpm.adb67
-rw-r--r--body/fltk-images-pixmaps.adb186
-rw-r--r--body/fltk-images-rgb-bmp.adb67
-rw-r--r--body/fltk-images-rgb-jpeg.adb92
-rw-r--r--body/fltk-images-rgb-png.adb94
-rw-r--r--body/fltk-images-rgb-pnm.adb67
-rw-r--r--body/fltk-images-rgb.adb270
-rw-r--r--body/fltk-images-shared.adb361
-rw-r--r--body/fltk-images-tiled.adb229
-rw-r--r--body/fltk-images.adb489
-rw-r--r--body/fltk-labels.adb355
-rw-r--r--body/fltk-menu_items.adb604
-rw-r--r--body/fltk-screen.adb282
-rw-r--r--body/fltk-show_argv.adb50
-rw-r--r--body/fltk-show_argv.ads35
-rw-r--r--body/fltk-static.adb1055
-rw-r--r--body/fltk-static_callback_conversions.adb176
-rw-r--r--body/fltk-static_callback_conversions.ads58
-rw-r--r--body/fltk-text_buffers.adb1352
-rw-r--r--body/fltk-tooltips.adb372
-rw-r--r--body/fltk-widget_callback_conversions.adb52
-rw-r--r--body/fltk-widget_callback_conversions.ads26
-rw-r--r--body/fltk-widgets-boxes.adb191
-rw-r--r--body/fltk-widgets-buttons-enter.adb152
-rw-r--r--body/fltk-widgets-buttons-light-check.adb170
-rw-r--r--body/fltk-widgets-buttons-light-radio.adb130
-rw-r--r--body/fltk-widgets-buttons-light-round-radio.adb130
-rw-r--r--body/fltk-widgets-buttons-light-round.adb129
-rw-r--r--body/fltk-widgets-buttons-light.adb152
-rw-r--r--body/fltk-widgets-buttons-radio.adb130
-rw-r--r--body/fltk-widgets-buttons-repeat.adb162
-rw-r--r--body/fltk-widgets-buttons-toggle.adb130
-rw-r--r--body/fltk-widgets-buttons.adb323
-rw-r--r--body/fltk-widgets-charts.adb453
-rw-r--r--body/fltk-widgets-clocks-updated-round.adb130
-rw-r--r--body/fltk-widgets-clocks-updated.adb185
-rw-r--r--body/fltk-widgets-clocks.adb262
-rw-r--r--body/fltk-widgets-groups-browsers-check.adb510
-rw-r--r--body/fltk-widgets-groups-browsers-textline-choice.adb249
-rw-r--r--body/fltk-widgets-groups-browsers-textline-file.adb524
-rw-r--r--body/fltk-widgets-groups-browsers-textline-hold.adb250
-rw-r--r--body/fltk-widgets-groups-browsers-textline-multi.adb249
-rw-r--r--body/fltk-widgets-groups-browsers-textline.adb1195
-rw-r--r--body/fltk-widgets-groups-browsers.adb1388
-rw-r--r--body/fltk-widgets-groups-color_choosers.adb395
-rw-r--r--body/fltk-widgets-groups-help_views.adb622
-rw-r--r--body/fltk-widgets-groups-input_choices.adb501
-rw-r--r--body/fltk-widgets-groups-packed.adb197
-rw-r--r--body/fltk-widgets-groups-scrolls.adb346
-rw-r--r--body/fltk-widgets-groups-spinners.adb536
-rw-r--r--body/fltk-widgets-groups-tabbed.adb302
-rw-r--r--body/fltk-widgets-groups-text_displays-text_editors.adb1232
-rw-r--r--body/fltk-widgets-groups-text_displays.adb1153
-rw-r--r--body/fltk-widgets-groups-tiled.adb186
-rw-r--r--body/fltk-widgets-groups-windows-double-cairo.adb248
-rw-r--r--body/fltk-widgets-groups-windows-double-overlay.adb317
-rw-r--r--body/fltk-widgets-groups-windows-double.adb260
-rw-r--r--body/fltk-widgets-groups-windows-opengl.adb580
-rw-r--r--body/fltk-widgets-groups-windows-single-menu.adb272
-rw-r--r--body/fltk-widgets-groups-windows-single.adb228
-rw-r--r--body/fltk-widgets-groups-windows.adb792
-rw-r--r--body/fltk-widgets-groups-wizards.adb219
-rw-r--r--body/fltk-widgets-groups.adb637
-rw-r--r--body/fltk-widgets-inputs-text-file.adb272
-rw-r--r--body/fltk-widgets-inputs-text-floating_point.adb156
-rw-r--r--body/fltk-widgets-inputs-text-multiline.adb130
-rw-r--r--body/fltk-widgets-inputs-text-outputs-multiline.adb130
-rw-r--r--body/fltk-widgets-inputs-text-outputs.adb130
-rw-r--r--body/fltk-widgets-inputs-text-secret.adb145
-rw-r--r--body/fltk-widgets-inputs-text-whole_number.adb156
-rw-r--r--body/fltk-widgets-inputs-text.adb192
-rw-r--r--body/fltk-widgets-inputs.adb947
-rw-r--r--body/fltk-widgets-menus-choices.adb239
-rw-r--r--body/fltk-widgets-menus-menu_bars-systemwide.adb619
-rw-r--r--body/fltk-widgets-menus-menu_bars.adb170
-rw-r--r--body/fltk-widgets-menus-menu_buttons.adb260
-rw-r--r--body/fltk-widgets-menus.adb1424
-rw-r--r--body/fltk-widgets-positioners.adb538
-rw-r--r--body/fltk-widgets-progress_bars.adb232
-rw-r--r--body/fltk-widgets-valuators-adjusters.adb201
-rw-r--r--body/fltk-widgets-valuators-counters-simple.adb130
-rw-r--r--body/fltk-widgets-valuators-counters.adb344
-rw-r--r--body/fltk-widgets-valuators-dials-fill.adb130
-rw-r--r--body/fltk-widgets-valuators-dials-line.adb130
-rw-r--r--body/fltk-widgets-valuators-dials.adb319
-rw-r--r--body/fltk-widgets-valuators-rollers.adb152
-rw-r--r--body/fltk-widgets-valuators-sliders-fill.adb130
-rw-r--r--body/fltk-widgets-valuators-sliders-horizontal.adb130
-rw-r--r--body/fltk-widgets-valuators-sliders-horizontal_fill.adb130
-rw-r--r--body/fltk-widgets-valuators-sliders-horizontal_nice.adb130
-rw-r--r--body/fltk-widgets-valuators-sliders-nice.adb129
-rw-r--r--body/fltk-widgets-valuators-sliders-scrollbars.adb275
-rw-r--r--body/fltk-widgets-valuators-sliders-value-horizontal.adb130
-rw-r--r--body/fltk-widgets-valuators-sliders-value.adb241
-rw-r--r--body/fltk-widgets-valuators-sliders.adb382
-rw-r--r--body/fltk-widgets-valuators-value_inputs.adb417
-rw-r--r--body/fltk-widgets-valuators-value_outputs.adb278
-rw-r--r--body/fltk-widgets-valuators.adb482
-rw-r--r--body/fltk-widgets.adb1280
-rw-r--r--body/fltk.adb425
345 files changed, 63741 insertions, 0 deletions
diff --git a/body/c_fl.cpp b/body/c_fl.cpp
new file mode 100644
index 0000000..ec5f7e5
--- /dev/null
+++ b/body/c_fl.cpp
@@ -0,0 +1,134 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Enumerations.H>
+#include <FL/Fl.H>
+#include "c_fl.h"
+
+
+
+
+const short fl_align_center = FL_ALIGN_CENTER;
+const short fl_align_top = FL_ALIGN_TOP;
+const short fl_align_bottom = FL_ALIGN_BOTTOM;
+const short fl_align_left = FL_ALIGN_LEFT;
+const short fl_align_right = FL_ALIGN_RIGHT;
+const short fl_align_inside = FL_ALIGN_INSIDE;
+const short fl_align_text_over_image = FL_ALIGN_TEXT_OVER_IMAGE;
+const short fl_align_image_over_text = FL_ALIGN_IMAGE_OVER_TEXT;
+const short fl_align_clip = FL_ALIGN_CLIP;
+const short fl_align_wrap = FL_ALIGN_WRAP;
+const short fl_align_image_next_to_text = FL_ALIGN_IMAGE_NEXT_TO_TEXT;
+const short fl_align_text_next_to_image = FL_ALIGN_TEXT_NEXT_TO_IMAGE;
+const short fl_align_image_backdrop = FL_ALIGN_IMAGE_BACKDROP;
+const short fl_align_top_left = FL_ALIGN_TOP_LEFT;
+const short fl_align_top_right = FL_ALIGN_TOP_RIGHT;
+const short fl_align_bottom_left = FL_ALIGN_BOTTOM_LEFT;
+const short fl_align_bottom_right = FL_ALIGN_BOTTOM_RIGHT;
+const short fl_align_left_top = FL_ALIGN_LEFT_TOP;
+const short fl_align_right_top = FL_ALIGN_RIGHT_TOP;
+const short fl_align_left_bottom = FL_ALIGN_LEFT_BOTTOM;
+const short fl_align_right_bottom = FL_ALIGN_RIGHT_BOTTOM;
+const short fl_align_nowrap = FL_ALIGN_NOWRAP;
+const short fl_align_all_position = FL_ALIGN_POSITION_MASK;
+const short fl_align_all_image = FL_ALIGN_IMAGE_MASK;
+
+
+
+
+const short fl_mod_command = FL_COMMAND >> 16;
+
+
+
+
+size_t c_pointer_size() {
+ return sizeof(void*);
+}
+
+
+
+
+unsigned int fl_enum_rgb_color(unsigned char r, unsigned char g, unsigned char b) {
+ return fl_rgb_color(r, g, b);
+}
+
+
+
+
+int fl_abi_check(int v) {
+ return Fl::abi_check(v);
+}
+
+int fl_abi_version() {
+ return Fl::abi_version();
+}
+
+int fl_api_version() {
+ return Fl::api_version();
+}
+
+double fl_version() {
+ return Fl::version();
+}
+
+
+
+
+void fl_awake() {
+ Fl::awake();
+}
+
+void fl_lock() {
+ Fl::lock();
+}
+
+void fl_unlock() {
+ Fl::unlock();
+}
+
+
+
+
+int fl_get_damage() {
+ return Fl::damage();
+}
+
+void fl_set_damage(int v) {
+ Fl::damage(v);
+}
+
+void fl_flush() {
+ Fl::flush();
+}
+
+void fl_redraw() {
+ Fl::redraw();
+}
+
+
+
+
+int fl_check() {
+ return Fl::check();
+}
+
+int fl_ready() {
+ return Fl::ready();
+}
+
+int fl_wait() {
+ return Fl::wait();
+}
+
+int fl_wait2(double s) {
+ return Fl::wait(s);
+}
+
+int fl_run() {
+ return Fl::run();
+}
+
+
diff --git a/body/c_fl.h b/body/c_fl.h
new file mode 100644
index 0000000..9f79979
--- /dev/null
+++ b/body/c_fl.h
@@ -0,0 +1,72 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_GUARD
+#define FL_GUARD
+
+
+extern "C" const short fl_align_center;
+extern "C" const short fl_align_top;
+extern "C" const short fl_align_bottom;
+extern "C" const short fl_align_left;
+extern "C" const short fl_align_right;
+extern "C" const short fl_align_inside;
+extern "C" const short fl_align_text_over_image;
+extern "C" const short fl_align_image_over_text;
+extern "C" const short fl_align_clip;
+extern "C" const short fl_align_wrap;
+extern "C" const short fl_align_image_next_to_text;
+extern "C" const short fl_align_text_next_to_image;
+extern "C" const short fl_align_image_backdrop;
+extern "C" const short fl_align_top_left;
+extern "C" const short fl_align_top_right;
+extern "C" const short fl_align_bottom_left;
+extern "C" const short fl_align_bottom_right;
+extern "C" const short fl_align_left_top;
+extern "C" const short fl_align_right_top;
+extern "C" const short fl_align_left_bottom;
+extern "C" const short fl_align_right_bottom;
+extern "C" const short fl_align_nowrap;
+extern "C" const short fl_align_all_position;
+extern "C" const short fl_align_all_image;
+
+
+extern "C" const short fl_mod_command;
+
+
+extern "C" size_t c_pointer_size();
+
+
+extern "C" unsigned int fl_enum_rgb_color(unsigned char r, unsigned char g, unsigned char b);
+
+
+extern "C" int fl_abi_check(int v);
+extern "C" int fl_abi_version();
+extern "C" int fl_api_version();
+extern "C" double fl_version();
+
+
+extern "C" void fl_awake();
+extern "C" void fl_lock();
+extern "C" void fl_unlock();
+
+
+extern "C" int fl_get_damage();
+extern "C" void fl_set_damage(int v);
+extern "C" void fl_flush();
+extern "C" void fl_redraw();
+
+
+extern "C" int fl_check();
+extern "C" int fl_ready();
+extern "C" int fl_wait();
+extern "C" int fl_wait2(double s);
+extern "C" int fl_run();
+
+
+#endif
+
+
diff --git a/body/c_fl_adjuster.cpp b/body/c_fl_adjuster.cpp
new file mode 100644
index 0000000..37a52cd
--- /dev/null
+++ b/body/c_fl_adjuster.cpp
@@ -0,0 +1,99 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Adjuster.H>
+#include "c_fl_adjuster.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Adjuster : Fl_Adjuster {
+public:
+ using Fl_Adjuster::value_damage;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Adjuster : public Fl_Adjuster {
+public:
+ using Fl_Adjuster::Fl_Adjuster;
+
+ friend void fl_adjuster_draw(ADJUSTER a);
+ friend int fl_adjuster_handle(ADJUSTER a, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Adjuster::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Adjuster::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Adjuster::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+ADJUSTER new_fl_adjuster(int x, int y, int w, int h, char* label) {
+ My_Adjuster *a = new My_Adjuster(x, y, w, h, label);
+ return a;
+}
+
+void free_fl_adjuster(ADJUSTER a) {
+ delete static_cast<My_Adjuster*>(a);
+}
+
+
+
+
+int fl_adjuster_is_soft(ADJUSTER a) {
+ return static_cast<Fl_Adjuster*>(a)->soft();
+}
+
+void fl_adjuster_set_soft(ADJUSTER a, int t) {
+ static_cast<Fl_Adjuster*>(a)->soft(t);
+}
+
+
+
+
+void fl_adjuster_value_damage(ADJUSTER a) {
+ (static_cast<Fl_Adjuster*>(a)->*(&Friend_Adjuster::value_damage))();
+}
+
+void fl_adjuster_draw(ADJUSTER a) {
+ static_cast<My_Adjuster*>(a)->Fl_Adjuster::draw();
+}
+
+int fl_adjuster_handle(ADJUSTER a, int e) {
+ return static_cast<My_Adjuster*>(a)->Fl_Adjuster::handle(e);
+}
+
+
diff --git a/body/c_fl_adjuster.h b/body/c_fl_adjuster.h
new file mode 100644
index 0000000..fbaa5ec
--- /dev/null
+++ b/body/c_fl_adjuster.h
@@ -0,0 +1,29 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_ADJUSTER_GUARD
+#define FL_ADJUSTER_GUARD
+
+
+typedef void* ADJUSTER;
+
+
+extern "C" ADJUSTER new_fl_adjuster(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_adjuster(ADJUSTER a);
+
+
+extern "C" int fl_adjuster_is_soft(ADJUSTER a);
+extern "C" void fl_adjuster_set_soft(ADJUSTER a, int t);
+
+
+extern "C" void fl_adjuster_value_damage(ADJUSTER a);
+extern "C" void fl_adjuster_draw(ADJUSTER a);
+extern "C" int fl_adjuster_handle(ADJUSTER a, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_ask.cpp b/body/c_fl_ask.cpp
new file mode 100644
index 0000000..20af2e3
--- /dev/null
+++ b/body/c_fl_ask.cpp
@@ -0,0 +1,140 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/fl_ask.H>
+#include <FL/Fl_File_Chooser.H>
+#include <FL/Fl_Color_Chooser.H>
+#include "c_fl_ask.h"
+
+
+
+
+const char * fl_ask_get_cancel() {
+ return fl_cancel;
+}
+
+void fl_ask_set_cancel(const char * v) {
+ fl_cancel = v;
+}
+
+const char * fl_ask_get_close() {
+ return fl_close;
+}
+
+void fl_ask_set_close(const char * v) {
+ fl_close = v;
+}
+
+const char * fl_ask_get_no() {
+ return fl_no;
+}
+
+void fl_ask_set_no(const char * v) {
+ fl_no = v;
+}
+
+const char * fl_ask_get_ok() {
+ return fl_ok;
+}
+
+void fl_ask_set_ok(const char * v) {
+ fl_ok = v;
+}
+
+const char * fl_ask_get_yes() {
+ return fl_yes;
+}
+
+void fl_ask_set_yes(const char * v) {
+ fl_yes = v;
+}
+
+
+
+
+void fl_ask_alert(const char * m) {
+ fl_alert(m);
+}
+
+void fl_ask_beep(int b) {
+ fl_beep(b);
+}
+
+int fl_ask_choice(const char * m, const char * a, const char * b, const char * c) {
+ return fl_choice(m, a, b, c);
+}
+
+int fl_ask_choice_n(const char * m, const char * a, const char * b, const char * c) {
+ return fl_choice_n(m, a, b, c);
+}
+
+const char * fl_ask_input(const char * m, const char * d) {
+ return fl_input(m, d);
+}
+
+void fl_ask_message(const char * m) {
+ fl_message(m);
+}
+
+const char * fl_ask_password(const char * m, const char * d) {
+ return fl_password(m, d);
+}
+
+
+
+
+int fl_ask_color_chooser(const char * n, double & r, double & g, double & b, int m) {
+ return fl_color_chooser(n, r, g, b, m);
+}
+
+int fl_ask_color_chooser2(const char * n, uchar & r, uchar & g, uchar & b, int m) {
+ return fl_color_chooser(n, r, g, b, m);
+}
+
+char * fl_ask_dir_chooser(const char * m, const char * d, int r) {
+ return fl_dir_chooser(m, d, r);
+}
+
+char * fl_ask_file_chooser(const char * m, const char * p, const char * d, int r) {
+ return fl_file_chooser(m, p, d, r);
+}
+
+void fl_ask_file_chooser_callback(void(*cb)(const char *)) {
+ fl_file_chooser_callback(cb);
+}
+
+void fl_ask_file_chooser_ok_label(const char *l) {
+ fl_file_chooser_ok_label(l);
+}
+
+
+
+
+int fl_ask_get_message_hotspot(void) {
+ return fl_message_hotspot();
+}
+
+void fl_ask_set_message_hotspot(int v) {
+ fl_message_hotspot(v);
+}
+
+void fl_ask_message_font(int f, int s) {
+ fl_message_font(f, s);
+}
+
+void * fl_ask_message_icon(void) {
+ return fl_message_icon();
+}
+
+void fl_ask_message_title(const char * t) {
+ fl_message_title(t);
+}
+
+void fl_ask_message_title_default(const char * t) {
+ fl_message_title_default(t);
+}
+
+
diff --git a/body/c_fl_ask.h b/body/c_fl_ask.h
new file mode 100644
index 0000000..f68bc85
--- /dev/null
+++ b/body/c_fl_ask.h
@@ -0,0 +1,50 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_ASK_GUARD
+#define FL_ASK_GUARD
+
+
+extern "C" const char * fl_ask_get_cancel();
+extern "C" void fl_ask_set_cancel(const char * v);
+extern "C" const char * fl_ask_get_close();
+extern "C" void fl_ask_set_close(const char * v);
+extern "C" const char * fl_ask_get_no();
+extern "C" void fl_ask_set_no(const char * v);
+extern "C" const char * fl_ask_get_ok();
+extern "C" void fl_ask_set_ok(const char * v);
+extern "C" const char * fl_ask_get_yes();
+extern "C" void fl_ask_set_yes(const char * v);
+
+
+extern "C" void fl_ask_alert(const char * m);
+extern "C" void fl_ask_beep(int b);
+extern "C" int fl_ask_choice(const char * m, const char * a, const char * b, const char * c);
+extern "C" int fl_ask_choice_n(const char * m, const char * a, const char * b, const char * c);
+extern "C" const char * fl_ask_input(const char * m, const char * d);
+extern "C" void fl_ask_message(const char * m);
+extern "C" const char * fl_ask_password(const char * m, const char * d);
+
+
+extern "C" int fl_ask_color_chooser(const char * n, double & r, double & g, double & b, int m);
+extern "C" int fl_ask_color_chooser2(const char * n, uchar & r, uchar & g, uchar & b, int m);
+extern "C" char * fl_ask_dir_chooser(const char * m, const char * d, int r);
+extern "C" char * fl_ask_file_chooser(const char * m, const char * p, const char * d, int r);
+extern "C" void fl_ask_file_chooser_callback(void(*cb)(const char *));
+extern "C" void fl_ask_file_chooser_ok_label(const char *l);
+
+
+extern "C" int fl_ask_get_message_hotspot(void);
+extern "C" void fl_ask_set_message_hotspot(int v);
+extern "C" void fl_ask_message_font(int f, int s);
+extern "C" void * fl_ask_message_icon(void);
+extern "C" void fl_ask_message_title(const char * t);
+extern "C" void fl_ask_message_title_default(const char * t);
+
+
+#endif
+
+
diff --git a/body/c_fl_bitmap.cpp b/body/c_fl_bitmap.cpp
new file mode 100644
index 0000000..01077b2
--- /dev/null
+++ b/body/c_fl_bitmap.cpp
@@ -0,0 +1,51 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Bitmap.H>
+#include "c_fl_bitmap.h"
+
+
+
+
+BITMAP new_fl_bitmap(void *data, int w, int h) {
+ Fl_Bitmap *b = new Fl_Bitmap(static_cast<uchar*>(data), w, h);
+ return b;
+}
+
+void free_fl_bitmap(BITMAP b) {
+ delete static_cast<Fl_Bitmap*>(b);
+}
+
+BITMAP fl_bitmap_copy(BITMAP b, int w, int h) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Bitmap*>(b)->Fl_Bitmap::copy(w, h);
+}
+
+BITMAP fl_bitmap_copy2(BITMAP b) {
+ return static_cast<Fl_Bitmap*>(b)->copy();
+}
+
+
+
+
+void fl_bitmap_uncache(BITMAP b) {
+ // virtual so disable dispatch
+ static_cast<Fl_Bitmap*>(b)->Fl_Bitmap::uncache();
+}
+
+
+
+
+void fl_bitmap_draw2(BITMAP b, int x, int y) {
+ static_cast<Fl_Bitmap*>(b)->draw(x, y);
+}
+
+void fl_bitmap_draw(BITMAP b, int x, int y, int w, int h, int cx, int cy) {
+ // virtual so disable dispatch
+ static_cast<Fl_Bitmap*>(b)->Fl_Bitmap::draw(x, y, w, h, cx, cy);
+}
+
+
diff --git a/body/c_fl_bitmap.h b/body/c_fl_bitmap.h
new file mode 100644
index 0000000..f5f6e15
--- /dev/null
+++ b/body/c_fl_bitmap.h
@@ -0,0 +1,29 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_BITMAP_GUARD
+#define FL_BITMAP_GUARD
+
+
+typedef void* BITMAP;
+
+
+extern "C" BITMAP new_fl_bitmap(void *data, int w, int h);
+extern "C" void free_fl_bitmap(BITMAP b);
+extern "C" BITMAP fl_bitmap_copy(BITMAP b, int w, int h);
+extern "C" BITMAP fl_bitmap_copy2(BITMAP b);
+
+
+extern "C" void fl_bitmap_uncache(BITMAP b);
+
+
+extern "C" void fl_bitmap_draw2(BITMAP b, int x, int y);
+extern "C" void fl_bitmap_draw(BITMAP b, int x, int y, int w, int h, int cx, int cy);
+
+
+#endif
+
+
diff --git a/body/c_fl_bmp_image.cpp b/body/c_fl_bmp_image.cpp
new file mode 100644
index 0000000..f068b8f
--- /dev/null
+++ b/body/c_fl_bmp_image.cpp
@@ -0,0 +1,22 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_BMP_Image.H>
+#include "c_fl_bmp_image.h"
+
+
+
+
+BMPIMAGE new_fl_bmp_image(const char * f) {
+ Fl_BMP_Image *b = new Fl_BMP_Image(f);
+ return b;
+}
+
+void free_fl_bmp_image(BMPIMAGE b) {
+ delete static_cast<Fl_BMP_Image*>(b);
+}
+
+
diff --git a/body/c_fl_bmp_image.h b/body/c_fl_bmp_image.h
new file mode 100644
index 0000000..e857fb7
--- /dev/null
+++ b/body/c_fl_bmp_image.h
@@ -0,0 +1,20 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_BMP_IMAGE_GUARD
+#define FL_BMP_IMAGE_GUARD
+
+
+typedef void* BMPIMAGE;
+
+
+extern "C" BMPIMAGE new_fl_bmp_image(const char * f);
+extern "C" void free_fl_bmp_image(BMPIMAGE b);
+
+
+#endif
+
+
diff --git a/body/c_fl_box.cpp b/body/c_fl_box.cpp
new file mode 100644
index 0000000..e9c170d
--- /dev/null
+++ b/body/c_fl_box.cpp
@@ -0,0 +1,72 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Box.H>
+#include "c_fl_box.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Box : public Fl_Box {
+public:
+ using Fl_Box::Fl_Box;
+
+ friend void fl_box_draw(BOX n);
+ friend int fl_box_handle(BOX n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Box::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Box::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+BOX new_fl_box(int x, int y, int w, int h, char* label) {
+ My_Box *b = new My_Box(x, y, w, h, label);
+ return b;
+}
+
+BOX new_fl_box2(int k, int x, int y, int w, int h, char * label) {
+ My_Box *b = new My_Box(static_cast<Fl_Boxtype>(k), x, y, w, h, label);
+ return b;
+}
+
+void free_fl_box(BOX b) {
+ delete static_cast<My_Box*>(b);
+}
+
+
+
+
+void fl_box_draw(BOX n) {
+ static_cast<My_Box*>(n)->Fl_Box::draw();
+}
+
+int fl_box_handle(BOX n, int e) {
+ return static_cast<My_Box*>(n)->Fl_Box::handle(e);
+}
+
+
diff --git a/body/c_fl_box.h b/body/c_fl_box.h
new file mode 100644
index 0000000..5143c3f
--- /dev/null
+++ b/body/c_fl_box.h
@@ -0,0 +1,25 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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" BOX new_fl_box2(int k, int x, int y, int w, int h, char * label);
+extern "C" void free_fl_box(BOX b);
+
+
+extern "C" void fl_box_draw(BOX n);
+extern "C" int fl_box_handle(BOX n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_browser.cpp b/body/c_fl_browser.cpp
new file mode 100644
index 0000000..bf700b7
--- /dev/null
+++ b/body/c_fl_browser.cpp
@@ -0,0 +1,448 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Browser.H>
+#include <FL/Fl_Image.H>
+#include "c_fl_browser.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" int browser_full_width_hook(void * b);
+extern "C" int browser_full_height_hook(void * b);
+extern "C" int browser_incr_height_hook(void * b);
+extern "C" int browser_item_quick_height_hook(void * b, void * i);
+
+extern "C" int browser_item_width_hook(void * b, void * i);
+extern "C" int browser_item_height_hook(void * b, void * i);
+extern "C" void * browser_item_first_hook(void * b);
+extern "C" void * browser_item_last_hook(void * b);
+extern "C" void * browser_item_next_hook(void * b, void * i);
+extern "C" void * browser_item_prev_hook(void * b, void * i);
+extern "C" void * browser_item_at_hook(void * b, int n);
+extern "C" void browser_item_select_hook(void * b, void * i, int s);
+extern "C" int browser_item_selected_hook(void * b, void * i);
+extern "C" void browser_item_swap_hook(void * b, void * one, void * two);
+extern "C" const char * browser_item_text_hook(void * b, void * i);
+extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h);
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Browser : Fl_Browser {
+public:
+ using Fl_Browser::lineno;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Browser : public Fl_Browser {
+public:
+ using Fl_Browser::Fl_Browser;
+
+ friend int fl_browser_item_width(BROWSER b, void * item);
+ friend int fl_browser_item_height(BROWSER b, void * item);
+ friend void * fl_browser_item_first(BROWSER b);
+ friend void * fl_browser_item_last(BROWSER b);
+ friend void * fl_browser_item_next(BROWSER b, void * item);
+ friend void * fl_browser_item_prev(BROWSER b, void * item);
+ friend void * fl_browser_item_at(BROWSER b, int index);
+ friend void fl_browser_item_select(BROWSER b, void * item, int val);
+ friend int fl_browser_item_selected(BROWSER b, void * item);
+ friend void fl_browser_item_swap(BROWSER b, void * x, void * y);
+ friend const char * fl_browser_item_text(BROWSER b, void * item);
+ friend void fl_browser_item_draw(BROWSER b, void * item, int x, int y, int w, int h);
+
+ friend int fl_browser_full_width(BROWSER c);
+ friend int fl_browser_full_height(BROWSER c);
+ friend int fl_browser_incr_height(BROWSER c);
+ friend int fl_browser_item_quick_height(BROWSER c, void * i);
+
+ friend void fl_browser_draw(BROWSER b);
+
+ int handle(int e);
+
+protected:
+ int full_width() const;
+ int full_height() const;
+ int incr_height() const;
+ int item_quick_height(void * item) const;
+
+ int item_width(void * item) const;
+ int item_height(void * item) const;
+ void * item_first() const;
+ void * item_last() const;
+ void * item_next(void * item) const;
+ void * item_prev(void * item) const;
+ void * item_at(int index) const;
+ void item_select(void * item, int val=1);
+ int item_selected(void * item) const;
+ void item_swap(void * a, void * b);
+ const char * item_text(void * item) const;
+ void item_draw(void * item, int x, int y, int w, int h) const;
+
+ void draw();
+};
+
+
+int My_Browser::full_width() const {
+ return browser_full_width_hook(this->user_data());
+}
+
+int My_Browser::full_height() const {
+ return browser_full_height_hook(this->user_data());
+}
+
+int My_Browser::incr_height() const {
+ return browser_incr_height_hook(this->user_data());
+}
+
+int My_Browser::item_quick_height(void * item) const {
+ return browser_item_quick_height_hook(this->user_data(), item);
+}
+
+
+int My_Browser::item_width(void * item) const {
+ return browser_item_width_hook(this->user_data(), item);
+}
+
+int My_Browser::item_height(void * item) const {
+ return browser_item_height_hook(this->user_data(), item);
+}
+
+void * My_Browser::item_first() const {
+ return browser_item_first_hook(this->user_data());
+}
+
+void * My_Browser::item_last() const {
+ return browser_item_last_hook(this->user_data());
+}
+
+void * My_Browser::item_next(void * item) const {
+ return browser_item_next_hook(this->user_data(), item);
+}
+
+void * My_Browser::item_prev(void * item) const {
+ return browser_item_prev_hook(this->user_data(), item);
+}
+
+void * My_Browser::item_at(int index) const {
+ return browser_item_at_hook(this->user_data(), index);
+}
+
+void My_Browser::item_select(void * item, int val) {
+ browser_item_select_hook(this->user_data(), item, val);
+}
+
+int My_Browser::item_selected(void * item) const {
+ return browser_item_selected_hook(this->user_data(), item);
+}
+
+void My_Browser::item_swap(void * a, void * b) {
+ browser_item_swap_hook(this->user_data(), a, b);
+}
+
+const char * My_Browser::item_text(void * item) const {
+ return browser_item_text_hook(this->user_data(), item);
+}
+
+void My_Browser::item_draw(void * item, int x, int y, int w, int h) const {
+ browser_item_draw_hook(this->user_data(), item, x, y, w, h);
+}
+
+
+void My_Browser::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Browser::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API begins here
+
+BROWSER new_fl_browser(int x, int y, int w, int h, char * label) {
+ My_Browser *b = new My_Browser(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_browser(BROWSER b) {
+ delete static_cast<My_Browser*>(b);
+}
+
+
+
+
+void fl_browser_add(BROWSER b, const char * text, void * d) {
+ static_cast<Fl_Browser*>(b)->add(text, d);
+}
+
+void fl_browser_insert(BROWSER b, int line, const char * text, void * d) {
+ static_cast<Fl_Browser*>(b)->insert(line, text, d);
+}
+
+void fl_browser_move(BROWSER b, int to, int from) {
+ static_cast<Fl_Browser*>(b)->move(to, from);
+}
+
+void fl_browser_swap(BROWSER b, int x, int y) {
+ static_cast<Fl_Browser*>(b)->swap(x, y);
+}
+
+void fl_browser_remove(BROWSER b, int line) {
+ static_cast<Fl_Browser*>(b)->remove(line);
+}
+
+void fl_browser_clear(BROWSER b) {
+ static_cast<Fl_Browser*>(b)->clear();
+}
+
+int fl_browser_size(BROWSER b) {
+ return static_cast<Fl_Browser*>(b)->size();
+}
+
+
+
+
+int fl_browser_load(BROWSER b, const char * f) {
+ return static_cast<Fl_Browser*>(b)->load(f);
+}
+
+const char * fl_browser_get_text(BROWSER b, int line) {
+ return static_cast<Fl_Browser*>(b)->text(line);
+}
+
+void fl_browser_set_text(BROWSER b, int line, const char * text) {
+ static_cast<Fl_Browser*>(b)->text(line, text);
+}
+
+int fl_browser_get_textsize(BROWSER b) {
+ return static_cast<Fl_Browser*>(b)->textsize();
+}
+
+void fl_browser_set_textsize(BROWSER b, int size) {
+ static_cast<Fl_Browser*>(b)->textsize(size);
+}
+
+
+
+
+char fl_browser_get_column_char(BROWSER b) {
+ return static_cast<Fl_Browser*>(b)->column_char();
+}
+
+void fl_browser_set_column_char(BROWSER b, char c) {
+ static_cast<Fl_Browser*>(b)->column_char(c);
+}
+
+void fl_browser_set_column_widths(BROWSER b, void * w) {
+ static_cast<Fl_Browser*>(b)->column_widths(static_cast<const int *>(w));
+}
+
+char fl_browser_get_format_char(BROWSER b) {
+ return static_cast<Fl_Browser*>(b)->format_char();
+}
+
+void fl_browser_set_format_char(BROWSER b, char c) {
+ static_cast<Fl_Browser*>(b)->format_char(c);
+}
+
+
+
+
+int fl_browser_get_topline(BROWSER b) {
+ return static_cast<Fl_Browser*>(b)->topline();
+}
+
+void fl_browser_set_topline(BROWSER b, int line) {
+ static_cast<Fl_Browser*>(b)->topline(line);
+}
+
+void fl_browser_middleline(BROWSER b, int line) {
+ static_cast<Fl_Browser*>(b)->middleline(line);
+}
+
+void fl_browser_bottomline(BROWSER b, int line) {
+ static_cast<Fl_Browser*>(b)->bottomline(line);
+}
+
+void fl_browser_lineposition(BROWSER b, int line, int p) {
+ static_cast<Fl_Browser*>(b)->lineposition
+ (line, static_cast<Fl_Browser::Fl_Line_Position>(p));
+}
+
+
+
+
+int fl_browser_select(BROWSER b, int l, int v) {
+ return static_cast<Fl_Browser*>(b)->select(l, v);
+}
+
+int fl_browser_selected(BROWSER b, int l) {
+ return static_cast<Fl_Browser*>(b)->selected(l);
+}
+
+int fl_browser_value(BROWSER b) {
+ return static_cast<Fl_Browser*>(b)->value();
+}
+
+
+
+
+int fl_browser_visible(BROWSER b, int l) {
+ return static_cast<Fl_Browser*>(b)->visible(l);
+}
+
+void fl_browser_make_visible(BROWSER b, int l) {
+ static_cast<Fl_Browser*>(b)->make_visible(l);
+}
+
+int fl_browser_displayed(BROWSER b, int l) {
+ return static_cast<Fl_Browser*>(b)->displayed(l);
+}
+
+void fl_browser_show_line(BROWSER b, int l) {
+ static_cast<Fl_Browser*>(b)->show(l);
+}
+
+void fl_browser_hide_line(BROWSER b, int l) {
+ static_cast<Fl_Browser*>(b)->hide(l);
+}
+
+void fl_browser_show(BROWSER b) {
+ static_cast<Fl_Browser*>(b)->show();
+}
+
+void fl_browser_hide(BROWSER b) {
+ static_cast<Fl_Browser*>(b)->hide();
+}
+
+
+
+
+void fl_browser_set_size(BROWSER b, int w, int h) {
+ static_cast<Fl_Browser*>(b)->size(w, h);
+}
+
+
+
+
+void fl_browser_set_icon(BROWSER b, int l, void * c) {
+ static_cast<Fl_Browser*>(b)->icon(l, static_cast<Fl_Image*>(c));
+}
+
+void fl_browser_remove_icon(BROWSER b, int l) {
+ static_cast<Fl_Browser*>(b)->remove_icon(l);
+}
+
+
+
+
+int fl_browser_full_height(BROWSER c) {
+ return static_cast<My_Browser*>(c)->Fl_Browser::full_height();
+}
+
+int fl_browser_incr_height(BROWSER c) {
+ return static_cast<My_Browser*>(c)->Fl_Browser::incr_height();
+}
+
+
+
+
+int fl_browser_item_width(BROWSER b, void * item) {
+ return static_cast<My_Browser*>(b)->Fl_Browser::item_width(item);
+}
+
+int fl_browser_item_height(BROWSER b, void * item) {
+ return static_cast<My_Browser*>(b)->Fl_Browser::item_height(item);
+}
+
+void * fl_browser_item_first(BROWSER b) {
+ return static_cast<My_Browser*>(b)->Fl_Browser::item_first();
+}
+
+void * fl_browser_item_last(BROWSER b) {
+ return static_cast<My_Browser*>(b)->Fl_Browser::item_last();
+}
+
+void * fl_browser_item_next(BROWSER b, void * item) {
+ return static_cast<My_Browser*>(b)->Fl_Browser::item_next(item);
+}
+
+void * fl_browser_item_prev(BROWSER b, void * item) {
+ return static_cast<My_Browser*>(b)->Fl_Browser::item_prev(item);
+}
+
+void * fl_browser_item_at(BROWSER b, int index) {
+ return static_cast<My_Browser*>(b)->Fl_Browser::item_at(index);
+}
+
+void fl_browser_item_select(BROWSER b, void * item, int val) {
+ static_cast<My_Browser*>(b)->Fl_Browser::item_select(item, val);
+}
+
+int fl_browser_item_selected(BROWSER b, void * item) {
+ return static_cast<My_Browser*>(b)->Fl_Browser::item_selected(item);
+}
+
+void fl_browser_item_swap(BROWSER b, void * x, void * y) {
+ static_cast<My_Browser*>(b)->Fl_Browser::item_swap(x, y);
+}
+
+const char * fl_browser_item_text(BROWSER b, void * item) {
+ return static_cast<My_Browser*>(b)->Fl_Browser::item_text(item);
+}
+
+void fl_browser_item_draw(BROWSER b, void * item, int x, int y, int w, int h) {
+ static_cast<My_Browser*>(b)->Fl_Browser::item_draw(item, x, y, w, h);
+}
+
+
+
+
+int fl_browser_lineno(BROWSER b, void * item) {
+ return (static_cast<Fl_Browser*>(b)->*(&Friend_Browser::lineno))(item);
+}
+
+
+
+
+// These have to be reimplemented due to relying on custom class extensions
+
+
+int fl_browser_full_width(BROWSER c) {
+ return static_cast<My_Browser*>(c)->Fl_Browser::full_width();
+}
+
+int fl_browser_item_quick_height(BROWSER c, void * i) {
+ return static_cast<My_Browser*>(c)->Fl_Browser::item_quick_height(i);
+}
+
+
+
+
+void fl_browser_draw(BROWSER b) {
+ static_cast<My_Browser*>(b)->Fl_Browser::draw();
+}
+
+int fl_browser_handle(BROWSER b, int e) {
+ return static_cast<My_Browser*>(b)->Fl_Browser::handle(e);
+}
+
+
diff --git a/body/c_fl_browser.h b/body/c_fl_browser.h
new file mode 100644
index 0000000..2729303
--- /dev/null
+++ b/body/c_fl_browser.h
@@ -0,0 +1,102 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_BROWSER_GUARD
+#define FL_BROWSER_GUARD
+
+
+typedef void* BROWSER;
+
+
+extern "C" BROWSER new_fl_browser(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_browser(BROWSER b);
+
+
+extern "C" void fl_browser_add(BROWSER b, const char * text, void * d=0);
+extern "C" void fl_browser_insert(BROWSER b, int line, const char * text, void * d=0);
+extern "C" void fl_browser_move(BROWSER b, int to, int from);
+extern "C" void fl_browser_swap(BROWSER b, int x, int y);
+extern "C" void fl_browser_remove(BROWSER b, int line);
+extern "C" void fl_browser_clear(BROWSER b);
+extern "C" int fl_browser_size(BROWSER b);
+
+
+extern "C" int fl_browser_load(BROWSER b, const char * f);
+extern "C" const char * fl_browser_get_text(BROWSER b, int line);
+extern "C" void fl_browser_set_text(BROWSER b, int line, const char * text);
+extern "C" int fl_browser_get_textsize(BROWSER b);
+extern "C" void fl_browser_set_textsize(BROWSER b, int size);
+
+
+extern "C" char fl_browser_get_column_char(BROWSER b);
+extern "C" void fl_browser_set_column_char(BROWSER b, char c);
+extern "C" void fl_browser_set_column_widths(BROWSER b, void * w);
+extern "C" char fl_browser_get_format_char(BROWSER b);
+extern "C" void fl_browser_set_format_char(BROWSER b, char c);
+
+
+extern "C" int fl_browser_get_topline(BROWSER b);
+extern "C" void fl_browser_set_topline(BROWSER b, int line);
+extern "C" void fl_browser_middleline(BROWSER b, int line);
+extern "C" void fl_browser_bottomline(BROWSER b, int line);
+extern "C" void fl_browser_lineposition(BROWSER b, int line, int p);
+
+
+extern "C" int fl_browser_select(BROWSER b, int l, int v);
+extern "C" int fl_browser_selected(BROWSER b, int l);
+extern "C" int fl_browser_value(BROWSER b);
+
+
+extern "C" int fl_browser_visible(BROWSER b, int l);
+extern "C" void fl_browser_make_visible(BROWSER b, int l);
+extern "C" int fl_browser_displayed(BROWSER b, int l);
+extern "C" void fl_browser_show_line(BROWSER b, int l);
+extern "C" void fl_browser_hide_line(BROWSER b, int l);
+extern "C" void fl_browser_show(BROWSER b);
+extern "C" void fl_browser_hide(BROWSER b);
+
+
+extern "C" void fl_browser_set_size(BROWSER b, int w, int h);
+
+
+extern "C" void fl_browser_set_icon(BROWSER b, int l, void * c);
+extern "C" void fl_browser_remove_icon(BROWSER b, int l);
+
+
+extern "C" int fl_browser_full_height(BROWSER c);
+extern "C" int fl_browser_incr_height(BROWSER c);
+
+
+extern "C" int fl_browser_item_width(BROWSER b, void * item);
+extern "C" int fl_browser_item_height(BROWSER b, void * item);
+extern "C" void * fl_browser_item_first(BROWSER b);
+extern "C" void * fl_browser_item_last(BROWSER b);
+extern "C" void * fl_browser_item_next(BROWSER b, void * item);
+extern "C" void * fl_browser_item_prev(BROWSER b, void * item);
+extern "C" void * fl_browser_item_at(BROWSER b, int index);
+extern "C" void fl_browser_item_select(BROWSER b, void * item, int val=1);
+extern "C" int fl_browser_item_selected(BROWSER b, void * item);
+extern "C" void fl_browser_item_swap(BROWSER b, void * x, void * y);
+extern "C" const char * fl_browser_item_text(BROWSER b, void * item);
+extern "C" void fl_browser_item_draw(BROWSER b, void * item, int x, int y, int w, int h);
+
+
+extern "C" int fl_browser_lineno(BROWSER b, void * item);
+
+
+// reimp below here
+
+extern "C" int fl_browser_full_width(BROWSER c);
+extern "C" int fl_browser_item_quick_height(BROWSER c, void * i);
+
+
+extern "C" void fl_browser_draw(BROWSER b);
+extern "C" int fl_browser_handle(BROWSER b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_browser_.cpp b/body/c_fl_browser_.cpp
new file mode 100644
index 0000000..58eaa3d
--- /dev/null
+++ b/body/c_fl_browser_.cpp
@@ -0,0 +1,392 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Browser_.H>
+#include "c_fl_browser_.h"
+
+
+
+
+const int fl_sort_ascending = FL_SORT_ASCENDING;
+const int fl_sort_descending = FL_SORT_DESCENDING;
+
+
+
+
+// Exports from Ada
+
+extern "C" int browser_full_width_hook(void * b);
+extern "C" int browser_full_height_hook(void * b);
+extern "C" int browser_incr_height_hook(void * b);
+extern "C" int browser_item_quick_height_hook(void * b, void * i);
+
+extern "C" int browser_item_width_hook(void * b, void * i);
+extern "C" int browser_item_height_hook(void * b, void * i);
+extern "C" void * browser_item_first_hook(void * b);
+extern "C" void * browser_item_last_hook(void * b);
+extern "C" void * browser_item_next_hook(void * b, void * i);
+extern "C" void * browser_item_prev_hook(void * b, void * i);
+extern "C" void * browser_item_at_hook(void * b, int n);
+extern "C" void browser_item_select_hook(void * b, void * i, int s);
+extern "C" int browser_item_selected_hook(void * b, void * i);
+extern "C" void browser_item_swap_hook(void * b, void * one, void * two);
+extern "C" const char * browser_item_text_hook(void * b, void * i);
+extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h);
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Browser_ : Fl_Browser_ {
+public:
+ using Fl_Browser_::selection;
+ using Fl_Browser_::displayed;
+ using Fl_Browser_::find_item;
+ using Fl_Browser_::top;
+
+ using Fl_Browser_::bbox;
+ using Fl_Browser_::leftedge;
+ using Fl_Browser_::redraw_line;
+ using Fl_Browser_::redraw_lines;
+
+ using Fl_Browser_::new_list;
+ using Fl_Browser_::inserting;
+ using Fl_Browser_::deleting;
+ using Fl_Browser_::replacing;
+ using Fl_Browser_::swapping;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Browser_ : public Fl_Browser_ {
+public:
+ using Fl_Browser_::Fl_Browser_;
+ friend ABSTRACTBROWSER new_fl_abstract_browser(int x, int y, int w, int h, char * label);
+
+ friend int fl_abstract_browser_full_width(ABSTRACTBROWSER b);
+ friend int fl_abstract_browser_full_height(ABSTRACTBROWSER b);
+ friend int fl_abstract_browser_incr_height(ABSTRACTBROWSER b);
+ friend int fl_abstract_browser_item_quick_height(ABSTRACTBROWSER b, void * i);
+
+ friend void fl_abstract_browser_draw(ABSTRACTBROWSER b);
+ friend int fl_abstract_browser_handle(ABSTRACTBROWSER b, int e);
+
+protected:
+ int full_width() const;
+ int full_height() const;
+ int incr_height() const;
+ int item_quick_height(void * item) const;
+
+ int item_width(void * item) const;
+ int item_height(void * item) const;
+ void * item_first() const;
+ void * item_last() const;
+ void * item_next(void * item) const;
+ void * item_prev(void * item) const;
+ void * item_at(int index) const;
+ void item_select(void * item, int val=1);
+ int item_selected(void * item) const;
+ void item_swap(void * a, void * b);
+ const char * item_text(void * item) const;
+ void item_draw(void * item, int x, int y, int w, int h) const;
+
+ void draw();
+ int handle(int e);
+};
+
+
+int My_Browser_::full_width() const {
+ return browser_full_width_hook(this->user_data());
+}
+
+int My_Browser_::full_height() const {
+ return browser_full_height_hook(this->user_data());
+}
+
+int My_Browser_::incr_height() const {
+ return browser_incr_height_hook(this->user_data());
+}
+
+int My_Browser_::item_quick_height(void * item) const {
+ return browser_item_quick_height_hook(this->user_data(), item);
+}
+
+
+int My_Browser_::item_width(void * item) const {
+ return browser_item_width_hook(this->user_data(), item);
+}
+
+int My_Browser_::item_height(void * item) const {
+ return browser_item_height_hook(this->user_data(), item);
+}
+
+void * My_Browser_::item_first() const {
+ return browser_item_first_hook(this->user_data());
+}
+
+void * My_Browser_::item_last() const {
+ return browser_item_last_hook(this->user_data());
+}
+
+void * My_Browser_::item_next(void * item) const {
+ return browser_item_next_hook(this->user_data(), item);
+}
+
+void * My_Browser_::item_prev(void * item) const {
+ return browser_item_prev_hook(this->user_data(), item);
+}
+
+void * My_Browser_::item_at(int index) const {
+ return browser_item_at_hook(this->user_data(), index);
+}
+
+void My_Browser_::item_select(void * item, int val) {
+ browser_item_select_hook(this->user_data(), item, val);
+}
+
+int My_Browser_::item_selected(void * item) const {
+ return browser_item_selected_hook(this->user_data(), item);
+}
+
+void My_Browser_::item_swap(void * a, void * b) {
+ browser_item_swap_hook(this->user_data(), a, b);
+}
+
+const char * My_Browser_::item_text(void * item) const {
+ return browser_item_text_hook(this->user_data(), item);
+}
+
+void My_Browser_::item_draw(void * item, int x, int y, int w, int h) const {
+ browser_item_draw_hook(this->user_data(), item, x, y, w, h);
+}
+
+
+void My_Browser_::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Browser_::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API begins here
+
+ABSTRACTBROWSER new_fl_abstract_browser(int x, int y, int w, int h, char * label) {
+ My_Browser_ *b = new My_Browser_(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_abstract_browser(ABSTRACTBROWSER b) {
+ delete static_cast<My_Browser_*>(b);
+}
+
+
+
+
+void * fl_abstract_browser_hscrollbar(ABSTRACTBROWSER b) {
+ return &static_cast<Fl_Browser_*>(b)->hscrollbar;
+}
+
+void * fl_abstract_browser_scrollbar(ABSTRACTBROWSER b) {
+ return &static_cast<Fl_Browser_*>(b)->scrollbar;
+}
+
+
+
+
+int fl_abstract_browser_select(ABSTRACTBROWSER b, void * i, int v, int c) {
+ return static_cast<Fl_Browser_*>(b)->select(i, v, c);
+}
+
+int fl_abstract_browser_select_only(ABSTRACTBROWSER b, void * i, int c) {
+ return static_cast<Fl_Browser_*>(b)->select_only(i, c);
+}
+
+void * fl_abstract_browser_selection(ABSTRACTBROWSER b) {
+ return (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::selection))();
+}
+
+int fl_abstract_browser_deselect(ABSTRACTBROWSER b, int c) {
+ return static_cast<Fl_Browser_*>(b)->deselect(c);
+}
+
+void fl_abstract_browser_display(ABSTRACTBROWSER b, void * i) {
+ static_cast<Fl_Browser_*>(b)->display(i);
+}
+
+int fl_abstract_browser_displayed(ABSTRACTBROWSER b, void * i) {
+ return (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::displayed))(i);
+}
+
+void * fl_abstract_browser_find_item(ABSTRACTBROWSER b, int y) {
+ return (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::find_item))(y);
+}
+
+void * fl_abstract_browser_top(ABSTRACTBROWSER b) {
+ return (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::top))();
+}
+
+void fl_abstract_browser_sort(ABSTRACTBROWSER b, int f) {
+ static_cast<Fl_Browser_*>(b)->sort(f);
+}
+
+
+
+
+unsigned char fl_abstract_browser_get_has_scrollbar(ABSTRACTBROWSER b) {
+ return static_cast<Fl_Browser_*>(b)->has_scrollbar();
+}
+
+void fl_abstract_browser_set_has_scrollbar(ABSTRACTBROWSER b, unsigned char m) {
+ static_cast<Fl_Browser_*>(b)->has_scrollbar(m);
+}
+
+int fl_abstract_browser_get_hposition(ABSTRACTBROWSER b) {
+ return static_cast<Fl_Browser_*>(b)->hposition();
+}
+
+void fl_abstract_browser_set_hposition(ABSTRACTBROWSER b, int p) {
+ static_cast<Fl_Browser_*>(b)->hposition(p);
+}
+
+int fl_abstract_browser_get_position(ABSTRACTBROWSER b) {
+ return static_cast<Fl_Browser_*>(b)->position();
+}
+
+void fl_abstract_browser_set_position(ABSTRACTBROWSER b, int p) {
+ static_cast<Fl_Browser_*>(b)->position(p);
+}
+
+void fl_abstract_browser_scrollbar_left(ABSTRACTBROWSER b) {
+ static_cast<Fl_Browser_*>(b)->scrollbar_left();
+}
+
+void fl_abstract_browser_scrollbar_right(ABSTRACTBROWSER b) {
+ static_cast<Fl_Browser_*>(b)->scrollbar_right();
+}
+
+int fl_abstract_browser_get_scrollbar_size(ABSTRACTBROWSER b) {
+ return static_cast<Fl_Browser_*>(b)->scrollbar_size();
+}
+
+void fl_abstract_browser_set_scrollbar_size(ABSTRACTBROWSER b, int s) {
+ static_cast<Fl_Browser_*>(b)->scrollbar_size(s);
+}
+
+
+
+
+unsigned int fl_abstract_browser_get_textcolor(ABSTRACTBROWSER b) {
+ return static_cast<Fl_Browser_*>(b)->textcolor();
+}
+
+void fl_abstract_browser_set_textcolor(ABSTRACTBROWSER b, unsigned int c) {
+ static_cast<Fl_Browser_*>(b)->textcolor(c);
+}
+
+int fl_abstract_browser_get_textfont(ABSTRACTBROWSER b) {
+ return static_cast<Fl_Browser_*>(b)->textfont();
+}
+
+void fl_abstract_browser_set_textfont(ABSTRACTBROWSER b, int f) {
+ static_cast<Fl_Browser_*>(b)->textfont(f);
+}
+
+int fl_abstract_browser_get_textsize(ABSTRACTBROWSER b) {
+ return static_cast<Fl_Browser_*>(b)->textsize();
+}
+
+void fl_abstract_browser_set_textsize(ABSTRACTBROWSER b, int s) {
+ static_cast<Fl_Browser_*>(b)->textsize(s);
+}
+
+
+
+
+void fl_abstract_browser_resize(ABSTRACTBROWSER b, int x, int y, int w, int h) {
+ static_cast<Fl_Browser_*>(b)->resize(x, y, w, h);
+}
+
+void fl_abstract_browser_bbox(ABSTRACTBROWSER b, int &x, int &y, int &w, int &h) {
+ (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::bbox))(x, y, w, h);
+}
+
+int fl_abstract_browser_leftedge(ABSTRACTBROWSER b) {
+ return (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::leftedge))();
+}
+
+void fl_abstract_browser_redraw_line(ABSTRACTBROWSER b, void * i) {
+ (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::redraw_line))(i);
+}
+
+void fl_abstract_browser_redraw_lines(ABSTRACTBROWSER b) {
+ (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::redraw_lines))();
+}
+
+
+
+
+int fl_abstract_browser_full_width(ABSTRACTBROWSER b) {
+ return static_cast<My_Browser_*>(b)->Fl_Browser_::full_width();
+}
+
+int fl_abstract_browser_full_height(ABSTRACTBROWSER b) {
+ return static_cast<My_Browser_*>(b)->Fl_Browser_::full_height();
+}
+
+int fl_abstract_browser_incr_height(ABSTRACTBROWSER b) {
+ return static_cast<My_Browser_*>(b)->Fl_Browser_::incr_height();
+}
+
+int fl_abstract_browser_item_quick_height(ABSTRACTBROWSER b, void * i) {
+ return static_cast<My_Browser_*>(b)->Fl_Browser_::item_quick_height(i);
+}
+
+
+
+
+void fl_abstract_browser_new_list(ABSTRACTBROWSER b) {
+ (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::new_list))();
+}
+
+void fl_abstract_browser_inserting(ABSTRACTBROWSER b, void * a1, void * a2) {
+ (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::inserting))(a1, a2);
+}
+
+void fl_abstract_browser_deleting(ABSTRACTBROWSER b, void * item) {
+ (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::deleting))(item);
+}
+
+void fl_abstract_browser_replacing(ABSTRACTBROWSER b, void * a1, void * a2) {
+ (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::replacing))(a1, a2);
+}
+
+void fl_abstract_browser_swapping(ABSTRACTBROWSER b, void * a1, void * a2) {
+ (static_cast<Fl_Browser_*>(b)->*(&Friend_Browser_::swapping))(a1, a2);
+}
+
+
+
+
+void fl_abstract_browser_draw(ABSTRACTBROWSER b) {
+ static_cast<My_Browser_*>(b)->Fl_Browser_::draw();
+}
+
+int fl_abstract_browser_handle(ABSTRACTBROWSER b, int e) {
+ return static_cast<My_Browser_*>(b)->Fl_Browser_::handle(e);
+}
+
+
diff --git a/body/c_fl_browser_.h b/body/c_fl_browser_.h
new file mode 100644
index 0000000..ed1157e
--- /dev/null
+++ b/body/c_fl_browser_.h
@@ -0,0 +1,83 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_ABSTRACT_BROWSER_GUARD
+#define FL_ABSTRACT_BROWSER_GUARD
+
+
+extern "C" const int fl_sort_ascending;
+extern "C" const int fl_sort_descending;
+
+
+typedef void* ABSTRACTBROWSER;
+
+
+extern "C" ABSTRACTBROWSER new_fl_abstract_browser(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_abstract_browser(ABSTRACTBROWSER b);
+
+
+extern "C" void * fl_abstract_browser_hscrollbar(ABSTRACTBROWSER b);
+extern "C" void * fl_abstract_browser_scrollbar(ABSTRACTBROWSER b);
+
+
+extern "C" int fl_abstract_browser_select(ABSTRACTBROWSER b, void * i, int v, int c);
+extern "C" int fl_abstract_browser_select_only(ABSTRACTBROWSER b, void * i, int c);
+extern "C" void * fl_abstract_browser_selection(ABSTRACTBROWSER b);
+extern "C" int fl_abstract_browser_deselect(ABSTRACTBROWSER b, int c);
+extern "C" void fl_abstract_browser_display(ABSTRACTBROWSER b, void * i);
+extern "C" int fl_abstract_browser_displayed(ABSTRACTBROWSER b, void * i);
+extern "C" void * fl_abstract_browser_find_item(ABSTRACTBROWSER b, int y);
+extern "C" void * fl_abstract_browser_top(ABSTRACTBROWSER b);
+extern "C" void fl_abstract_browser_sort(ABSTRACTBROWSER b, int f);
+
+
+extern "C" unsigned char fl_abstract_browser_get_has_scrollbar(ABSTRACTBROWSER b);
+extern "C" void fl_abstract_browser_set_has_scrollbar(ABSTRACTBROWSER b, unsigned char m);
+extern "C" int fl_abstract_browser_get_hposition(ABSTRACTBROWSER b);
+extern "C" void fl_abstract_browser_set_hposition(ABSTRACTBROWSER b, int p);
+extern "C" int fl_abstract_browser_get_position(ABSTRACTBROWSER b);
+extern "C" void fl_abstract_browser_set_position(ABSTRACTBROWSER b, int p);
+extern "C" void fl_abstract_browser_scrollbar_left(ABSTRACTBROWSER b);
+extern "C" void fl_abstract_browser_scrollbar_right(ABSTRACTBROWSER b);
+extern "C" int fl_abstract_browser_get_scrollbar_size(ABSTRACTBROWSER b);
+extern "C" void fl_abstract_browser_set_scrollbar_size(ABSTRACTBROWSER b, int s);
+
+
+extern "C" unsigned int fl_abstract_browser_get_textcolor(ABSTRACTBROWSER b);
+extern "C" void fl_abstract_browser_set_textcolor(ABSTRACTBROWSER b, unsigned int c);
+extern "C" int fl_abstract_browser_get_textfont(ABSTRACTBROWSER b);
+extern "C" void fl_abstract_browser_set_textfont(ABSTRACTBROWSER b, int f);
+extern "C" int fl_abstract_browser_get_textsize(ABSTRACTBROWSER b);
+extern "C" void fl_abstract_browser_set_textsize(ABSTRACTBROWSER b, int s);
+
+
+extern "C" void fl_abstract_browser_resize(ABSTRACTBROWSER b, int x, int y, int w, int h);
+extern "C" void fl_abstract_browser_bbox(ABSTRACTBROWSER b, int &x, int &y, int &w, int &h);
+extern "C" int fl_abstract_browser_leftedge(ABSTRACTBROWSER b);
+extern "C" void fl_abstract_browser_redraw_line(ABSTRACTBROWSER b, void * i);
+extern "C" void fl_abstract_browser_redraw_lines(ABSTRACTBROWSER b);
+
+
+extern "C" int fl_abstract_browser_full_width(ABSTRACTBROWSER b);
+extern "C" int fl_abstract_browser_full_height(ABSTRACTBROWSER b);
+extern "C" int fl_abstract_browser_incr_height(ABSTRACTBROWSER b);
+extern "C" int fl_abstract_browser_item_quick_height(ABSTRACTBROWSER b, void * i);
+
+
+extern "C" void fl_abstract_browser_new_list(ABSTRACTBROWSER b);
+extern "C" void fl_abstract_browser_inserting(ABSTRACTBROWSER b, void * a1, void * a2);
+extern "C" void fl_abstract_browser_deleting(ABSTRACTBROWSER b, void * item);
+extern "C" void fl_abstract_browser_replacing(ABSTRACTBROWSER b, void * a1, void * a2);
+extern "C" void fl_abstract_browser_swapping(ABSTRACTBROWSER b, void * a1, void * a2);
+
+
+extern "C" void fl_abstract_browser_draw(ABSTRACTBROWSER b);
+extern "C" int fl_abstract_browser_handle(ABSTRACTBROWSER b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_button.cpp b/body/c_fl_button.cpp
new file mode 100644
index 0000000..409b190
--- /dev/null
+++ b/body/c_fl_button.cpp
@@ -0,0 +1,133 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Button.H>
+#include "c_fl_button.h"
+
+
+
+
+// Telprot stopovers
+
+extern "C" void button_extra_init_hook(void * aobj, int x, int y, int w, int h, const char * l);
+void fl_button_extra_init(void * adaobj, int x, int y, int w, int h, const char * label) {
+ button_extra_init_hook(adaobj, x, y, w, h, label);
+}
+
+extern "C" void button_extra_final_hook(void * aobj);
+void fl_button_extra_final(void * adaobj) {
+ button_extra_final_hook(adaobj);
+}
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Button : Fl_Button {
+public:
+ using Fl_Button::simulate_key_action;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Button : public Fl_Button {
+public:
+ using Fl_Button::Fl_Button;
+
+ friend void fl_button_draw(BUTTON b);
+ friend int fl_button_handle(BUTTON b, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Button::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Button::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+BUTTON new_fl_button(int x, int y, int w, int h, char* label) {
+ My_Button *b = new My_Button(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_button(BUTTON b) {
+ delete static_cast<My_Button*>(b);
+}
+
+
+
+
+int fl_button_get_state(BUTTON b) {
+ return static_cast<Fl_Button*>(b)->Fl_Button::value();
+}
+
+void fl_button_set_state(BUTTON b, int s) {
+ static_cast<Fl_Button*>(b)->Fl_Button::value(s);
+}
+
+void fl_button_set_only(BUTTON b) {
+ static_cast<Fl_Button*>(b)->Fl_Button::setonly();
+}
+
+
+
+
+int fl_button_get_down_box(BUTTON b) {
+ return static_cast<Fl_Button*>(b)->Fl_Button::down_box();
+}
+
+void fl_button_set_down_box(BUTTON b, int t) {
+ static_cast<Fl_Button*>(b)->Fl_Button::down_box(static_cast<Fl_Boxtype>(t));
+}
+
+int fl_button_get_shortcut(BUTTON b) {
+ return static_cast<Fl_Button*>(b)->Fl_Button::shortcut();
+}
+
+void fl_button_set_shortcut(BUTTON b, int k) {
+ static_cast<Fl_Button*>(b)->Fl_Button::shortcut(k);
+}
+
+
+
+
+void fl_button_draw(BUTTON b) {
+ static_cast<My_Button*>(b)->Fl_Button::draw();
+}
+
+int fl_button_handle(BUTTON b, int e) {
+ return static_cast<My_Button*>(b)->Fl_Button::handle(e);
+}
+
+
+
+
+void fl_button_simulate_key_action(BUTTON b) {
+ (static_cast<Fl_Button*>(b)->*(&Friend_Button::simulate_key_action))();
+}
+
+
diff --git a/body/c_fl_button.h b/body/c_fl_button.h
new file mode 100644
index 0000000..f644a50
--- /dev/null
+++ b/body/c_fl_button.h
@@ -0,0 +1,42 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_BUTTON_GUARD
+#define FL_BUTTON_GUARD
+
+
+extern "C" void fl_button_extra_init(void * adaobj, int x, int y, int w, int h, const char * label);
+extern "C" void fl_button_extra_final(void * adaobj);
+
+
+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);
+
+
+extern "C" int fl_button_get_down_box(BUTTON b);
+extern "C" void fl_button_set_down_box(BUTTON b, int t);
+extern "C" int fl_button_get_shortcut(BUTTON b);
+extern "C" void fl_button_set_shortcut(BUTTON b, int k);
+
+
+extern "C" void fl_button_draw(BUTTON b);
+extern "C" int fl_button_handle(BUTTON b, int e);
+
+
+extern "C" void fl_button_simulate_key_action(BUTTON b);
+
+
+#endif
+
+
diff --git a/body/c_fl_cairo_window.cpp b/body/c_fl_cairo_window.cpp
new file mode 100644
index 0000000..4bf75f0
--- /dev/null
+++ b/body/c_fl_cairo_window.cpp
@@ -0,0 +1,98 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Cairo_Window.H>
+#include <FL/Fl_Double_Window.H>
+#include "c_fl_cairo_window.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Cairo_Window :
+#ifdef FLTK_HAVE_CAIRO
+public Fl_Cairo_Window
+#else
+public Fl_Double_Window
+#endif
+{
+public:
+#ifdef FLTK_HAVE_CAIRO
+ using Fl_Cairo_Window::Fl_Cairo_Window;
+#else
+ using Fl_Double_Window::Fl_Double_Window;
+#endif
+
+ friend void fl_cairo_window_draw(CAIROWINDOW w);
+
+ int handle(int e);
+ void draw();
+};
+
+
+void My_Cairo_Window::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Cairo_Window::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API begins here
+
+CAIROWINDOW new_fl_cairo_window(int w, int h) {
+ My_Cairo_Window *c = new My_Cairo_Window(w, h);
+ return c;
+}
+
+void free_fl_cairo_window(CAIROWINDOW w) {
+ delete static_cast<My_Cairo_Window*>(w);
+}
+
+
+
+
+void fl_cairo_window_set_draw_cb(CAIROWINDOW w, void * cb) {
+ #ifdef FLTK_HAVE_CAIRO
+ static_cast<Fl_Cairo_Window*>(w)->set_draw_cb(reinterpret_cast<cairo_draw_cb>(cb));
+ #else
+ (void)(w);
+ (void)(cb);
+ #endif
+}
+
+
+
+
+void fl_cairo_window_draw(CAIROWINDOW w) {
+ #ifdef FLTK_HAVE_CAIRO
+ static_cast<My_Cairo_Window*>(w)->Fl_Cairo_Window::draw();
+ #else
+ static_cast<My_Cairo_Window*>(w)->Fl_Double_Window::draw();
+ #endif
+}
+
+int fl_cairo_window_handle(CAIROWINDOW w, int e) {
+ #ifdef FLTK_HAVE_CAIRO
+ return static_cast<My_Cairo_Window*>(w)->Fl_Cairo_Window::handle(e);
+ #else
+ return static_cast<My_Cairo_Window*>(w)->Fl_Double_Window::handle(e);
+ #endif
+}
+
+
diff --git a/body/c_fl_cairo_window.h b/body/c_fl_cairo_window.h
new file mode 100644
index 0000000..d004d16
--- /dev/null
+++ b/body/c_fl_cairo_window.h
@@ -0,0 +1,27 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_CAIRO_WINDOW_GUARD
+#define FL_CAIRO_WINDOW_GUARD
+
+
+typedef void* CAIROWINDOW;
+
+
+extern "C" CAIROWINDOW new_fl_cairo_window(int w, int h);
+extern "C" void free_fl_cairo_window(CAIROWINDOW w);
+
+
+extern "C" void fl_cairo_window_set_draw_cb(CAIROWINDOW w, void * cb);
+
+
+extern "C" void fl_cairo_window_draw(CAIROWINDOW w);
+extern "C" int fl_cairo_window_handle(CAIROWINDOW w, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_chart.cpp b/body/c_fl_chart.cpp
new file mode 100644
index 0000000..c065327
--- /dev/null
+++ b/body/c_fl_chart.cpp
@@ -0,0 +1,151 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Chart.H>
+#include "c_fl_chart.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Chart : public Fl_Chart {
+public:
+ using Fl_Chart::Fl_Chart;
+
+ friend void fl_chart_draw(CHART n);
+ friend int fl_chart_handle(CHART n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Chart::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Chart::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+CHART new_fl_chart(int x, int y, int w, int h, char* label) {
+ My_Chart *b = new My_Chart(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_chart(CHART b) {
+ delete static_cast<My_Chart*>(b);
+}
+
+
+
+
+void fl_chart_add(CHART b, double v, char * s, unsigned int c) {
+ static_cast<Fl_Chart*>(b)->add(v,s,c);
+}
+
+void fl_chart_insert(CHART b, int i, double v, char * s, unsigned int c) {
+ static_cast<Fl_Chart*>(b)->insert(i,v,s,c);
+}
+
+void fl_chart_replace(CHART b, int i, double v, char * s, unsigned int c) {
+ static_cast<Fl_Chart*>(b)->replace(i,v,s,c);
+}
+
+void fl_chart_clear(CHART b) {
+ static_cast<Fl_Chart*>(b)->clear();
+}
+
+
+
+
+int fl_chart_get_autosize(CHART b) {
+ return static_cast<Fl_Chart*>(b)->autosize();
+}
+
+void fl_chart_set_autosize(CHART b, int a) {
+ static_cast<Fl_Chart*>(b)->autosize(a);
+}
+
+void fl_chart_get_bounds(CHART b, double * l, double * u) {
+ static_cast<Fl_Chart*>(b)->bounds(l,u);
+}
+
+void fl_chart_set_bounds(CHART b, double l, double u) {
+ static_cast<Fl_Chart*>(b)->bounds(l,u);
+}
+
+int fl_chart_get_maxsize(CHART b) {
+ return static_cast<Fl_Chart*>(b)->maxsize();
+}
+
+void fl_chart_set_maxsize(CHART b, int m) {
+ static_cast<Fl_Chart*>(b)->maxsize(m);
+}
+
+int fl_chart_size(CHART b) {
+ return static_cast<Fl_Chart*>(b)->size();
+}
+
+
+
+
+void fl_chart_size2(CHART b, int w, int h) {
+ static_cast<Fl_Chart*>(b)->size(w, h);
+}
+
+
+
+
+unsigned int fl_chart_get_textcolor(CHART b) {
+ return static_cast<Fl_Chart*>(b)->textcolor();
+}
+
+void fl_chart_set_textcolor(CHART b, unsigned int c) {
+ static_cast<Fl_Chart*>(b)->textcolor(c);
+}
+
+int fl_chart_get_textfont(CHART b) {
+ return static_cast<Fl_Chart*>(b)->textfont();
+}
+
+void fl_chart_set_textfont(CHART b, int f) {
+ static_cast<Fl_Chart*>(b)->textfont(f);
+}
+
+int fl_chart_get_textsize(CHART b) {
+ return static_cast<Fl_Chart*>(b)->textsize();
+}
+
+void fl_chart_set_textsize(CHART b, int s) {
+ static_cast<Fl_Chart*>(b)->textsize(s);
+}
+
+
+
+
+void fl_chart_draw(CHART n) {
+ static_cast<My_Chart*>(n)->Fl_Chart::draw();
+}
+
+int fl_chart_handle(CHART n, int e) {
+ return static_cast<My_Chart*>(n)->Fl_Chart::handle(e);
+}
+
+
diff --git a/body/c_fl_chart.h b/body/c_fl_chart.h
new file mode 100644
index 0000000..bd524c3
--- /dev/null
+++ b/body/c_fl_chart.h
@@ -0,0 +1,50 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_CHART_GUARD
+#define FL_CHART_GUARD
+
+
+typedef void* CHART;
+
+
+extern "C" CHART new_fl_chart(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_chart(CHART b);
+
+
+extern "C" void fl_chart_add(CHART b, double v, char * s, unsigned int c);
+extern "C" void fl_chart_insert(CHART b, int i, double v, char * s, unsigned int c);
+extern "C" void fl_chart_replace(CHART b, int i, double v, char * s, unsigned int c);
+extern "C" void fl_chart_clear(CHART b);
+
+
+extern "C" int fl_chart_get_autosize(CHART b);
+extern "C" void fl_chart_set_autosize(CHART b, int a);
+extern "C" void fl_chart_get_bounds(CHART b, double * l, double * u);
+extern "C" void fl_chart_set_bounds(CHART b, double l, double u);
+extern "C" int fl_chart_get_maxsize(CHART b);
+extern "C" void fl_chart_set_maxsize(CHART b, int m);
+extern "C" int fl_chart_size(CHART b);
+
+
+extern "C" void fl_chart_size2(CHART b, int w, int h);
+
+
+extern "C" unsigned int fl_chart_get_textcolor(CHART b);
+extern "C" void fl_chart_set_textcolor(CHART b, unsigned int c);
+extern "C" int fl_chart_get_textfont(CHART b);
+extern "C" void fl_chart_set_textfont(CHART b, int f);
+extern "C" int fl_chart_get_textsize(CHART b);
+extern "C" void fl_chart_set_textsize(CHART b, int s);
+
+
+extern "C" void fl_chart_draw(CHART n);
+extern "C" int fl_chart_handle(CHART n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_check_browser.cpp b/body/c_fl_check_browser.cpp
new file mode 100644
index 0000000..947dc63
--- /dev/null
+++ b/body/c_fl_check_browser.cpp
@@ -0,0 +1,336 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Check_Browser.H>
+#include <FL/Fl_Browser_.H>
+#include "c_fl_check_browser.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" int browser_full_width_hook(void * b);
+extern "C" int browser_full_height_hook(void * b);
+extern "C" int browser_incr_height_hook(void * b);
+extern "C" int browser_item_quick_height_hook(void * b, void * i);
+
+// These browser_item_* hooks are disabled since if they are used to hook
+// into Ada using virtual dispatch then there will be no way to access the
+// real Fl_Check_Browser versions once coming back into C++ via C since the
+// versions we want to actually use here are private in FLTK because reasons.
+
+// Should be possible to re-enable in 1.4.
+
+// extern "C" int browser_item_width_hook(void * b, void * i);
+// extern "C" int browser_item_height_hook(void * b, void * i);
+// extern "C" void * browser_item_first_hook(void * b);
+// extern "C" void * browser_item_last_hook(void * b);
+// extern "C" void * browser_item_next_hook(void * b, void * i);
+// extern "C" void * browser_item_prev_hook(void * b, void * i);
+// extern "C" void * browser_item_at_hook(void * b, int n);
+// extern "C" void browser_item_select_hook(void * b, void * i, int s);
+// extern "C" int browser_item_selected_hook(void * b, void * i);
+// extern "C" void browser_item_swap_hook(void * b, void * one, void * two);
+// extern "C" const char * browser_item_text_hook(void * b, void * i);
+// extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h);
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected / private access
+
+class Friend_Browser : Fl_Browser_ {
+public:
+ using Fl_Browser_::item_width;
+ using Fl_Browser_::item_height;
+ using Fl_Browser_::item_first;
+ using Fl_Browser_::item_next;
+ using Fl_Browser_::item_prev;
+ using Fl_Browser_::item_select;
+ using Fl_Browser_::item_selected;
+ using Fl_Browser_::item_draw;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Check_Browser : public Fl_Check_Browser {
+public:
+ using Fl_Check_Browser::Fl_Check_Browser;
+
+ friend int fl_check_browser_full_width(CHECKBROWSER c);
+ friend int fl_check_browser_full_height(CHECKBROWSER c);
+ friend int fl_check_browser_incr_height(CHECKBROWSER c);
+ friend int fl_check_browser_item_quick_height(CHECKBROWSER c, void * i);
+
+ friend int fl_check_browser_item_width(CHECKBROWSER c, void * i);
+ friend int fl_check_browser_item_height(CHECKBROWSER c, void * i);
+ friend void * fl_check_browser_item_first(CHECKBROWSER c);
+ // item_last goes here
+ friend void * fl_check_browser_item_next(CHECKBROWSER c, void * i);
+ friend void * fl_check_browser_item_prev(CHECKBROWSER c, void * i);
+ // item_at goes here
+ friend void fl_check_browser_item_select(CHECKBROWSER c, void * i, int v);
+ friend int fl_check_browser_item_selected(CHECKBROWSER c, void * i);
+ // item_swap goes here
+ // item_text goes here
+ friend void fl_check_browser_item_draw(CHECKBROWSER c, void * item, int x, int y, int w, int h);
+
+ friend void fl_check_browser_draw(CHECKBROWSER c);
+ friend int fl_check_browser_handle(CHECKBROWSER c, int e);
+
+protected:
+ int full_width() const;
+ int full_height() const;
+ int incr_height() const;
+ int item_quick_height(void * item) const;
+
+ // int item_width(void * item) const;
+ // int item_height(void * item) const;
+ // void * item_first() const;
+ // void * item_last() const;
+ // void * item_next(void * item) const;
+ // void * item_prev(void * item) const;
+ // void * item_at(int index) const;
+ // void item_select(void * item, int val=1);
+ // int item_selected(void * item) const;
+ // void item_swap(void * a, void * b);
+ // const char * item_text(void * item) const;
+ // void item_draw(void * item, int x, int y, int w, int h) const;
+
+ void draw();
+ int handle(int e);
+};
+
+
+int My_Check_Browser::full_width() const {
+ return browser_full_width_hook(this->user_data());
+}
+
+int My_Check_Browser::full_height() const {
+ return browser_full_height_hook(this->user_data());
+}
+
+int My_Check_Browser::incr_height() const {
+ return browser_incr_height_hook(this->user_data());
+}
+
+int My_Check_Browser::item_quick_height(void * item) const {
+ return browser_item_quick_height_hook(this->user_data(), item);
+}
+
+
+// int My_Check_Browser::item_width(void * item) const {
+// return browser_item_width_hook(this->user_data(), item);
+// }
+
+// int My_Check_Browser::item_height(void * item) const {
+// return browser_item_height_hook(this->user_data(), item);
+// }
+
+// void * My_Check_Browser::item_first() const {
+// return browser_item_first_hook(this->user_data());
+// }
+
+// void * My_Check_Browser::item_last() const {
+// return browser_item_last_hook(this->user_data());
+// }
+
+// void * My_Check_Browser::item_next(void * item) const {
+// return browser_item_next_hook(this->user_data(), item);
+// }
+
+// void * My_Check_Browser::item_prev(void * item) const {
+// return browser_item_prev_hook(this->user_data(), item);
+// }
+
+// void * My_Check_Browser::item_at(int index) const {
+// return browser_item_at_hook(this->user_data(), index);
+// }
+
+// void My_Check_Browser::item_select(void * item, int val) {
+// browser_item_select_hook(this->user_data(), item, val);
+// }
+
+// int My_Check_Browser::item_selected(void * item) const {
+// return browser_item_selected_hook(this->user_data(), item);
+// }
+
+// void My_Check_Browser::item_swap(void * a, void * b) {
+// browser_item_swap_hook(this->user_data(), a, b);
+// }
+
+// const char * My_Check_Browser::item_text(void * item) const {
+// return browser_item_text_hook(this->user_data(), item);
+// }
+
+// void My_Check_Browser::item_draw(void * item, int x, int y, int w, int h) const {
+// browser_item_draw_hook(this->user_data(), item, x, y, w, h);
+// }
+
+
+void My_Check_Browser::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Check_Browser::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API begins here
+
+CHECKBROWSER new_fl_check_browser(int x, int y, int w, int h, char * label) {
+ My_Check_Browser *c = new My_Check_Browser(x, y, w, h, label);
+ return c;
+}
+
+void free_fl_check_browser(CHECKBROWSER c) {
+ delete static_cast<My_Check_Browser*>(c);
+}
+
+
+
+
+int fl_check_browser_add(CHECKBROWSER c, const char * s, int b) {
+ return static_cast<Fl_Check_Browser*>(c)->add(s, b);
+}
+
+int fl_check_browser_remove(CHECKBROWSER c, int i) {
+ return static_cast<Fl_Check_Browser*>(c)->remove(i);
+}
+
+void fl_check_browser_clear(CHECKBROWSER c) {
+ static_cast<Fl_Check_Browser*>(c)->clear();
+}
+
+int fl_check_browser_nitems(CHECKBROWSER c) {
+ return static_cast<Fl_Check_Browser*>(c)->nitems();
+}
+
+
+
+
+void fl_check_browser_check_all(CHECKBROWSER c) {
+ static_cast<Fl_Check_Browser*>(c)->check_all();
+}
+
+void fl_check_browser_check_none(CHECKBROWSER c) {
+ static_cast<Fl_Check_Browser*>(c)->check_none();
+}
+
+int fl_check_browser_get_checked(CHECKBROWSER c, int i) {
+ return static_cast<Fl_Check_Browser*>(c)->checked(i);
+}
+
+void fl_check_browser_set_checked(CHECKBROWSER c, int i, int b) {
+ static_cast<Fl_Check_Browser*>(c)->checked(i, b);
+}
+
+int fl_check_browser_nchecked(CHECKBROWSER c) {
+ return static_cast<Fl_Check_Browser*>(c)->nchecked();
+}
+
+
+
+
+const char * fl_check_browser_text(CHECKBROWSER c, int i) {
+ return static_cast<Fl_Check_Browser*>(c)->text(i);
+}
+
+int fl_check_browser_value(CHECKBROWSER c) {
+ return static_cast<Fl_Check_Browser*>(c)->value();
+}
+
+
+
+
+int fl_check_browser_full_width(CHECKBROWSER c) {
+ return static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::full_width();
+}
+
+int fl_check_browser_full_height(CHECKBROWSER c) {
+ return static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::full_height();
+}
+
+int fl_check_browser_incr_height(CHECKBROWSER c) {
+ return static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::incr_height();
+}
+
+int fl_check_browser_item_quick_height(CHECKBROWSER c, void * i) {
+ return static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_quick_height(i);
+}
+
+
+
+
+int fl_check_browser_item_width(CHECKBROWSER c, void * i) {
+ return (static_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_width))(i);
+ // return static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_width(i);
+}
+
+int fl_check_browser_item_height(CHECKBROWSER c, void * i) {
+ return (static_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_height))(i);
+ // return static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_height(i);
+}
+
+void * fl_check_browser_item_first(CHECKBROWSER c) {
+ return (static_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_first))();
+ // return static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_first();
+}
+
+// missing item_last
+
+void * fl_check_browser_item_next(CHECKBROWSER c, void * i) {
+ return (static_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_next))(i);
+ // return static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_next(i);
+}
+
+void * fl_check_browser_item_prev(CHECKBROWSER c, void * i) {
+ return (static_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_prev))(i);
+ // return static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_prev(i);
+}
+
+// missing item_at
+
+void fl_check_browser_item_select(CHECKBROWSER c, void * i, int v) {
+ (static_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_select))(i, v);
+ // static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_select(i, v);
+}
+
+int fl_check_browser_item_selected(CHECKBROWSER c, void * i) {
+ return (static_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_selected))(i);
+ // return static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_selected(i);
+}
+
+// missing item_swap
+// missing item_text
+
+void fl_check_browser_item_draw(CHECKBROWSER c, void * item, int x, int y, int w, int h) {
+ (static_cast<Fl_Check_Browser*>(c)->*(&Friend_Browser::item_draw))(item, x, y, w, h);
+ // static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::item_draw(item, x, y, w, h);
+}
+
+
+
+
+void fl_check_browser_draw(CHECKBROWSER c) {
+ static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::draw();
+}
+
+int fl_check_browser_handle(CHECKBROWSER c, int e) {
+ return static_cast<My_Check_Browser*>(c)->Fl_Check_Browser::handle(e);
+}
+
+
diff --git a/body/c_fl_check_browser.h b/body/c_fl_check_browser.h
new file mode 100644
index 0000000..e9e832e
--- /dev/null
+++ b/body/c_fl_check_browser.h
@@ -0,0 +1,61 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_CHECK_BROWSER_GUARD
+#define FL_CHECK_BROWSER_GUARD
+
+
+typedef void* CHECKBROWSER;
+
+
+extern "C" CHECKBROWSER new_fl_check_browser(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_check_browser(CHECKBROWSER c);
+
+
+extern "C" int fl_check_browser_add(CHECKBROWSER c, const char * s, int b);
+extern "C" int fl_check_browser_remove(CHECKBROWSER c, int i);
+extern "C" void fl_check_browser_clear(CHECKBROWSER c);
+extern "C" int fl_check_browser_nitems(CHECKBROWSER c);
+
+
+extern "C" void fl_check_browser_check_all(CHECKBROWSER c);
+extern "C" void fl_check_browser_check_none(CHECKBROWSER c);
+extern "C" int fl_check_browser_get_checked(CHECKBROWSER c, int i);
+extern "C" void fl_check_browser_set_checked(CHECKBROWSER c, int i, int b);
+extern "C" int fl_check_browser_nchecked(CHECKBROWSER c);
+
+
+extern "C" const char * fl_check_browser_text(CHECKBROWSER c, int i);
+extern "C" int fl_check_browser_value(CHECKBROWSER c);
+
+
+extern "C" int fl_check_browser_full_width(CHECKBROWSER c);
+extern "C" int fl_check_browser_full_height(CHECKBROWSER c);
+extern "C" int fl_check_browser_incr_height(CHECKBROWSER c);
+extern "C" int fl_check_browser_item_quick_height(CHECKBROWSER c, void * i);
+
+
+extern "C" int fl_check_browser_item_width(CHECKBROWSER c, void * i);
+extern "C" int fl_check_browser_item_height(CHECKBROWSER c, void * i);
+extern "C" void * fl_check_browser_item_first(CHECKBROWSER c);
+// missing item_last
+extern "C" void * fl_check_browser_item_next(CHECKBROWSER c, void * i);
+extern "C" void * fl_check_browser_item_prev(CHECKBROWSER c, void * i);
+// missing item_at
+extern "C" void fl_check_browser_item_select(CHECKBROWSER c, void * i, int v);
+extern "C" int fl_check_browser_item_selected(CHECKBROWSER c, void * i);
+// missing item_swap
+// missing item_text
+extern "C" void fl_check_browser_item_draw(CHECKBROWSER c, void * item, int x, int y, int w, int h);
+
+
+extern "C" void fl_check_browser_draw(CHECKBROWSER c);
+extern "C" int fl_check_browser_handle(CHECKBROWSER c, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_check_button.cpp b/body/c_fl_check_button.cpp
new file mode 100644
index 0000000..8dab449
--- /dev/null
+++ b/body/c_fl_check_button.cpp
@@ -0,0 +1,83 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Check_Button.H>
+#include "c_fl_check_button.h"
+
+
+
+
+// Telprot stopovers
+
+extern "C" void check_button_extra_init_hook
+ (void * aobj, int x, int y, int w, int h, const char * l);
+void fl_check_button_extra_init (void * adaobj, int x, int y, int w, int h, const char * label) {
+ check_button_extra_init_hook(adaobj, x, y, w, h, label);
+}
+
+extern "C" void check_button_extra_final_hook(void * aobj);
+void fl_check_button_extra_final(void * adaobj) {
+ check_button_extra_final_hook(adaobj);
+}
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Check_Button : public Fl_Check_Button {
+public:
+ using Fl_Check_Button::Fl_Check_Button;
+
+ friend void fl_check_button_draw(CHECKBUTTON b);
+ friend int fl_check_button_handle(CHECKBUTTON b, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Check_Button::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Check_Button::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+CHECKBUTTON new_fl_check_button(int x, int y, int w, int h, char* label) {
+ My_Check_Button *b = new My_Check_Button(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_check_button(CHECKBUTTON b) {
+ delete static_cast<My_Check_Button*>(b);
+}
+
+
+
+
+void fl_check_button_draw(CHECKBUTTON b) {
+ static_cast<My_Check_Button*>(b)->Fl_Check_Button::draw();
+}
+
+int fl_check_button_handle(CHECKBUTTON b, int e) {
+ return static_cast<My_Check_Button*>(b)->Fl_Check_Button::handle(e);
+}
+
+
diff --git a/body/c_fl_check_button.h b/body/c_fl_check_button.h
new file mode 100644
index 0000000..cfa6bff
--- /dev/null
+++ b/body/c_fl_check_button.h
@@ -0,0 +1,29 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_CHECK_BUTTON_GUARD
+#define FL_CHECK_BUTTON_GUARD
+
+
+extern "C" void fl_check_button_extra_init
+ (void * adaobj, int x, int y, int w, int h, const char * label);
+extern "C" void fl_check_button_extra_final(void * adaobj);
+
+
+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);
+
+
+extern "C" void fl_check_button_draw(CHECKBUTTON b);
+extern "C" int fl_check_button_handle(CHECKBUTTON b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_choice.cpp b/body/c_fl_choice.cpp
new file mode 100644
index 0000000..4b03532
--- /dev/null
+++ b/body/c_fl_choice.cpp
@@ -0,0 +1,82 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Choice.H>
+#include "c_fl_choice.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Choice : public Fl_Choice {
+public:
+ using Fl_Choice::Fl_Choice;
+
+ friend void fl_choice_draw(CHOICE n);
+ friend int fl_choice_handle(CHOICE n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Choice::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Choice::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+CHOICE new_fl_choice(int x, int y, int w, int h, char* label) {
+ My_Choice *b = new My_Choice(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_choice(CHOICE b) {
+ delete static_cast<My_Choice*>(b);
+}
+
+
+
+
+int fl_choice_value(CHOICE c) {
+ return static_cast<Fl_Choice*>(c)->value();
+}
+
+int fl_choice_set_value(CHOICE c, void * i) {
+ return static_cast<Fl_Choice*>(c)->value(static_cast<Fl_Menu_Item*>(i));
+}
+
+int fl_choice_set_value2(CHOICE c, int p) {
+ return static_cast<Fl_Choice*>(c)->value(p);
+}
+
+
+
+
+void fl_choice_draw(CHOICE n) {
+ static_cast<My_Choice*>(n)->Fl_Choice::draw();
+}
+
+int fl_choice_handle(CHOICE n, int e) {
+ return static_cast<My_Choice*>(n)->Fl_Choice::handle(e);
+}
+
+
diff --git a/body/c_fl_choice.h b/body/c_fl_choice.h
new file mode 100644
index 0000000..031e67e
--- /dev/null
+++ b/body/c_fl_choice.h
@@ -0,0 +1,29 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_CHOICE_GUARD
+#define FL_CHOICE_GUARD
+
+
+typedef void* CHOICE;
+
+
+extern "C" CHOICE new_fl_choice(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_choice(CHOICE b);
+
+
+extern "C" int fl_choice_value(CHOICE c);
+extern "C" int fl_choice_set_value(CHOICE c, void * i);
+extern "C" int fl_choice_set_value2(CHOICE c, int p);
+
+
+extern "C" void fl_choice_draw(CHOICE n);
+extern "C" int fl_choice_handle(CHOICE n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_clock.cpp b/body/c_fl_clock.cpp
new file mode 100644
index 0000000..e2df99c
--- /dev/null
+++ b/body/c_fl_clock.cpp
@@ -0,0 +1,72 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Clock.H>
+#include "c_fl_clock.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Clock : public Fl_Clock {
+public:
+ using Fl_Clock::Fl_Clock;
+
+ friend void fl_clock_draw(CLOCK c);
+ friend int fl_clock_handle(CLOCK c, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Clock::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Clock::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+CLOCK new_fl_clock(int x, int y, int w, int h, char* label) {
+ My_Clock *c = new My_Clock(x, y, w, h, label);
+ return c;
+}
+
+CLOCK new_fl_clock2(unsigned char k, int x, int y, int w, int h, char* label) {
+ My_Clock *c = new My_Clock(k,x,y,w,h,label);
+ return c;
+}
+
+void free_fl_clock(CLOCK c) {
+ delete static_cast<My_Clock*>(c);
+}
+
+
+
+
+void fl_clock_draw(CLOCK c) {
+ static_cast<My_Clock*>(c)->Fl_Clock::draw();
+}
+
+int fl_clock_handle(CLOCK c, int e) {
+ return static_cast<My_Clock*>(c)->Fl_Clock::handle(e);
+}
+
+
diff --git a/body/c_fl_clock.h b/body/c_fl_clock.h
new file mode 100644
index 0000000..4b07d7e
--- /dev/null
+++ b/body/c_fl_clock.h
@@ -0,0 +1,25 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_CLOCK_GUARD
+#define FL_CLOCK_GUARD
+
+
+typedef void* CLOCK;
+
+
+extern "C" CLOCK new_fl_clock(int x, int y, int w, int h, char* label);
+extern "C" CLOCK new_fl_clock2(unsigned char k, int x, int y, int w, int h, char* label);
+extern "C" void free_fl_clock(CLOCK c);
+
+
+extern "C" void fl_clock_draw(CLOCK c);
+extern "C" int fl_clock_handle(CLOCK c, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_clock_output.cpp b/body/c_fl_clock_output.cpp
new file mode 100644
index 0000000..a34b1c4
--- /dev/null
+++ b/body/c_fl_clock_output.cpp
@@ -0,0 +1,111 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Clock.H>
+#include "c_fl_clock_output.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Clock_Output : Fl_Clock_Output {
+public:
+ // Really only needed for the (int,int,int,int) version
+ using Fl_Clock_Output::draw;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Clock_Output : public Fl_Clock_Output {
+public:
+ using Fl_Clock_Output::Fl_Clock_Output;
+
+ friend void fl_clock_output_draw(CLOCKOUTPUT c);
+ friend int fl_clock_output_handle(CLOCKOUTPUT c, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Clock_Output::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Clock_Output::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+CLOCKOUTPUT new_fl_clock_output(int x, int y, int w, int h, char* label) {
+ My_Clock_Output *c = new My_Clock_Output(x, y, w, h, label);
+ return c;
+}
+
+void free_fl_clock_output(CLOCKOUTPUT c) {
+ delete static_cast<My_Clock_Output*>(c);
+}
+
+
+
+
+int fl_clock_output_get_hour(CLOCKOUTPUT c) {
+ return static_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::hour();
+}
+
+int fl_clock_output_get_minute(CLOCKOUTPUT c) {
+ return static_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::minute();
+}
+
+int fl_clock_output_get_second(CLOCKOUTPUT c) {
+ return static_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::second();
+}
+
+
+unsigned long fl_clock_output_get_value(CLOCKOUTPUT c) {
+ return static_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::value();
+}
+
+void fl_clock_output_set_value(CLOCKOUTPUT c, unsigned long v) {
+ static_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::value(v);
+}
+
+void fl_clock_output_set_value2(CLOCKOUTPUT c, int h, int m, int s) {
+ static_cast<Fl_Clock_Output*>(c)->Fl_Clock_Output::value(h,m,s);
+}
+
+
+
+
+void fl_clock_output_draw(CLOCKOUTPUT c) {
+ static_cast<My_Clock_Output*>(c)->Fl_Clock_Output::draw();
+}
+
+void fl_clock_output_draw2(CLOCKOUTPUT c, int x, int y, int w, int h) {
+ void (Fl_Clock_Output::*mydraw)(int,int,int,int) = &Friend_Clock_Output::draw;
+ (static_cast<Fl_Clock_Output*>(c)->*mydraw)(x, y, w, h);
+}
+
+int fl_clock_output_handle(CLOCKOUTPUT c, int e) {
+ return static_cast<My_Clock_Output*>(c)->Fl_Clock_Output::handle(e);
+}
+
+
diff --git a/body/c_fl_clock_output.h b/body/c_fl_clock_output.h
new file mode 100644
index 0000000..6098b25
--- /dev/null
+++ b/body/c_fl_clock_output.h
@@ -0,0 +1,35 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_CLOCK_OUTPUT_GUARD
+#define FL_CLOCK_OUTPUT_GUARD
+
+
+typedef void* CLOCKOUTPUT;
+
+
+extern "C" CLOCKOUTPUT new_fl_clock_output(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_clock_output(CLOCKOUTPUT c);
+
+
+extern "C" int fl_clock_output_get_hour(CLOCKOUTPUT c);
+extern "C" int fl_clock_output_get_minute(CLOCKOUTPUT c);
+extern "C" int fl_clock_output_get_second(CLOCKOUTPUT c);
+
+
+extern "C" unsigned long fl_clock_output_get_value(CLOCKOUTPUT c);
+extern "C" void fl_clock_output_set_value(CLOCKOUTPUT c, unsigned long v);
+extern "C" void fl_clock_output_set_value2(CLOCKOUTPUT c, int h, int m, int s);
+
+
+extern "C" void fl_clock_output_draw(CLOCKOUTPUT c);
+extern "C" void fl_clock_output_draw2(CLOCKOUTPUT c, int x, int y, int w, int h);
+extern "C" int fl_clock_output_handle(CLOCKOUTPUT c, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_color_chooser.cpp b/body/c_fl_color_chooser.cpp
new file mode 100644
index 0000000..31551b8
--- /dev/null
+++ b/body/c_fl_color_chooser.cpp
@@ -0,0 +1,127 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Color_Chooser.H>
+#include "c_fl_color_chooser.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Color_Chooser : public Fl_Color_Chooser {
+public:
+ using Fl_Color_Chooser::Fl_Color_Chooser;
+
+ friend void fl_color_chooser_draw(COLORCHOOSER n);
+ friend int fl_color_chooser_handle(COLORCHOOSER n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Color_Chooser::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Color_Chooser::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+COLORCHOOSER new_fl_color_chooser(int x, int y, int w, int h, char* label) {
+ My_Color_Chooser *n = new My_Color_Chooser(x, y, w, h, label);
+ return n;
+}
+
+void free_fl_color_chooser(COLORCHOOSER n) {
+ delete static_cast<My_Color_Chooser*>(n);
+}
+
+
+
+
+double fl_color_chooser_r(COLORCHOOSER n) {
+ return static_cast<Fl_Color_Chooser*>(n)->r();
+}
+
+double fl_color_chooser_g(COLORCHOOSER n) {
+ return static_cast<Fl_Color_Chooser*>(n)->g();
+}
+
+double fl_color_chooser_b(COLORCHOOSER n) {
+ return static_cast<Fl_Color_Chooser*>(n)->b();
+}
+
+int fl_color_chooser_rgb(COLORCHOOSER n, int r, int g, int b) {
+ return static_cast<Fl_Color_Chooser*>(n)->rgb(r,g,b);
+}
+
+
+
+
+double fl_color_chooser_hue(COLORCHOOSER n) {
+ return static_cast<Fl_Color_Chooser*>(n)->hue();
+}
+
+double fl_color_chooser_saturation(COLORCHOOSER n) {
+ return static_cast<Fl_Color_Chooser*>(n)->saturation();
+}
+
+double fl_color_chooser_value(COLORCHOOSER n) {
+ return static_cast<Fl_Color_Chooser*>(n)->value();
+}
+
+int fl_color_chooser_hsv(COLORCHOOSER n, int h, int s, int v) {
+ return static_cast<Fl_Color_Chooser*>(n)->hsv(h,s,v);
+}
+
+
+
+
+void fl_color_chooser_hsv2rgb(double h, double s, double v, double &r, double &g, double &b) {
+ Fl_Color_Chooser::hsv2rgb(h,s,v,r,g,b);
+}
+
+void fl_color_chooser_rgb2hsv(double r, double g, double b, double &h, double &s, double &v) {
+ Fl_Color_Chooser::rgb2hsv(r,g,b,h,s,v);
+}
+
+
+
+
+int fl_color_chooser_get_mode(COLORCHOOSER n) {
+ return static_cast<Fl_Color_Chooser*>(n)->mode();
+}
+
+void fl_color_chooser_set_mode(COLORCHOOSER n, int m) {
+ static_cast<Fl_Color_Chooser*>(n)->mode(m);
+}
+
+
+
+
+void fl_color_chooser_draw(COLORCHOOSER n) {
+ static_cast<My_Color_Chooser*>(n)->Fl_Color_Chooser::draw();
+}
+
+int fl_color_chooser_handle(COLORCHOOSER n, int e) {
+ return static_cast<My_Color_Chooser*>(n)->Fl_Color_Chooser::handle(e);
+}
+
+
diff --git a/body/c_fl_color_chooser.h b/body/c_fl_color_chooser.h
new file mode 100644
index 0000000..22f9bc7
--- /dev/null
+++ b/body/c_fl_color_chooser.h
@@ -0,0 +1,46 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_COLOR_CHOOSER_GUARD
+#define FL_COLOR_CHOOSER_GUARD
+
+
+typedef void* COLORCHOOSER;
+
+
+extern "C" COLORCHOOSER new_fl_color_chooser(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_color_chooser(COLORCHOOSER n);
+
+
+extern "C" double fl_color_chooser_r(COLORCHOOSER n);
+extern "C" double fl_color_chooser_g(COLORCHOOSER n);
+extern "C" double fl_color_chooser_b(COLORCHOOSER n);
+extern "C" int fl_color_chooser_rgb(COLORCHOOSER n, int r, int g, int b);
+
+
+extern "C" double fl_color_chooser_hue(COLORCHOOSER n);
+extern "C" double fl_color_chooser_saturation(COLORCHOOSER n);
+extern "C" double fl_color_chooser_value(COLORCHOOSER n);
+extern "C" int fl_color_chooser_hsv(COLORCHOOSER n, int h, int s, int v);
+
+
+extern "C" void fl_color_chooser_hsv2rgb
+ (double h, double s, double v, double &r, double &g, double &b);
+extern "C" void fl_color_chooser_rgb2hsv
+ (double r, double g, double b, double &h, double &s, double &v);
+
+
+extern "C" int fl_color_chooser_get_mode(COLORCHOOSER n);
+extern "C" void fl_color_chooser_set_mode(COLORCHOOSER n, int m);
+
+
+extern "C" void fl_color_chooser_draw(COLORCHOOSER n);
+extern "C" int fl_color_chooser_handle(COLORCHOOSER n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_copy_surface.cpp b/body/c_fl_copy_surface.cpp
new file mode 100644
index 0000000..a13b314
--- /dev/null
+++ b/body/c_fl_copy_surface.cpp
@@ -0,0 +1,55 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Copy_Surface.H>
+#include <FL/Fl_Widget.H>
+#include <FL/Fl_Window.H>
+#include "c_fl_copy_surface.h"
+
+
+
+
+// Flattened C API
+
+COPYSURFACE new_fl_copy_surface(int w, int h) {
+ Fl_Copy_Surface *c = new Fl_Copy_Surface(w,h);
+ return c;
+}
+
+void free_fl_copy_surface(COPYSURFACE c) {
+ delete static_cast<Fl_Copy_Surface*>(c);
+}
+
+
+
+
+int fl_copy_surface_get_w(COPYSURFACE c) {
+ return static_cast<Fl_Copy_Surface*>(c)->w();
+}
+
+int fl_copy_surface_get_h(COPYSURFACE c) {
+ return static_cast<Fl_Copy_Surface*>(c)->h();
+}
+
+
+
+
+void fl_copy_surface_draw(COPYSURFACE c, void * w, int dx, int dy) {
+ static_cast<Fl_Copy_Surface*>(c)->draw(static_cast<Fl_Widget*>(w),dx,dy);
+}
+
+void fl_copy_surface_draw_decorated_window(COPYSURFACE c, void * w, int dx, int dy) {
+ static_cast<Fl_Copy_Surface*>(c)->draw_decorated_window(static_cast<Fl_Window*>(w),dx,dy);
+}
+
+
+
+
+void fl_copy_surface_set_current(COPYSURFACE c) {
+ static_cast<Fl_Copy_Surface*>(c)->set_current();
+}
+
+
diff --git a/body/c_fl_copy_surface.h b/body/c_fl_copy_surface.h
new file mode 100644
index 0000000..81d14b8
--- /dev/null
+++ b/body/c_fl_copy_surface.h
@@ -0,0 +1,31 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_COPY_SURFACE_GUARD
+#define CL_COPY_SURFACE_GUARD
+
+
+typedef void* COPYSURFACE;
+
+
+extern "C" COPYSURFACE new_fl_copy_surface(int w, int h);
+extern "C" void free_fl_copy_surface(COPYSURFACE c);
+
+
+extern "C" int fl_copy_surface_get_w(COPYSURFACE c);
+extern "C" int fl_copy_surface_get_h(COPYSURFACE c);
+
+
+extern "C" void fl_copy_surface_draw(COPYSURFACE c, void * w, int dx, int dy);
+extern "C" void fl_copy_surface_draw_decorated_window(COPYSURFACE c, void * w, int dx, int dy);
+
+
+extern "C" void fl_copy_surface_set_current(COPYSURFACE c);
+
+
+#endif
+
+
diff --git a/body/c_fl_counter.cpp b/body/c_fl_counter.cpp
new file mode 100644
index 0000000..9fe5d20
--- /dev/null
+++ b/body/c_fl_counter.cpp
@@ -0,0 +1,120 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Counter.H>
+#include "c_fl_counter.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Counter : public Fl_Counter {
+public:
+ using Fl_Counter::Fl_Counter;
+
+ friend void fl_counter_draw(COUNTER c);
+ friend int fl_counter_handle(COUNTER c, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Counter::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Counter::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Counter::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+COUNTER new_fl_counter(int x, int y, int w, int h, char* label) {
+ My_Counter *c = new My_Counter(x, y, w, h, label);
+ return c;
+}
+
+void free_fl_counter(COUNTER c) {
+ delete static_cast<My_Counter*>(c);
+}
+
+
+
+
+double fl_counter_get_step(COUNTER c) {
+ return static_cast<Fl_Counter*>(c)->step();
+}
+
+void fl_counter_set_step_top(COUNTER c, double t) {
+ static_cast<Fl_Counter*>(c)->step(t);
+}
+
+void fl_counter_set_lstep(COUNTER c, double t) {
+ static_cast<Fl_Counter*>(c)->lstep(t);
+}
+
+void fl_counter_set_step_both(COUNTER c, double s, double l) {
+ static_cast<Fl_Counter*>(c)->step(s, l);
+}
+
+
+
+
+unsigned int fl_counter_get_textcolor(COUNTER c) {
+ return static_cast<Fl_Counter*>(c)->textcolor();
+}
+
+void fl_counter_set_textcolor(COUNTER c, unsigned int t) {
+ static_cast<Fl_Counter*>(c)->textcolor(t);
+}
+
+int fl_counter_get_textfont(COUNTER c) {
+ return static_cast<Fl_Counter*>(c)->textfont();
+}
+
+void fl_counter_set_textfont(COUNTER c, int t) {
+ static_cast<Fl_Counter*>(c)->textfont(t);
+}
+
+int fl_counter_get_textsize(COUNTER c) {
+ return static_cast<Fl_Counter*>(c)->textsize();
+}
+
+void fl_counter_set_textsize(COUNTER c, int t) {
+ static_cast<Fl_Counter*>(c)->textsize(t);
+}
+
+
+
+
+void fl_counter_draw(COUNTER c) {
+ static_cast<My_Counter*>(c)->Fl_Counter::draw();
+}
+
+int fl_counter_handle(COUNTER c, int e) {
+ return static_cast<My_Counter*>(c)->Fl_Counter::handle(e);
+}
+
+
diff --git a/body/c_fl_counter.h b/body/c_fl_counter.h
new file mode 100644
index 0000000..b5b4a8b
--- /dev/null
+++ b/body/c_fl_counter.h
@@ -0,0 +1,38 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_COUNTER_GUARD
+#define FL_COUNTER_GUARD
+
+
+typedef void* COUNTER;
+
+
+extern "C" COUNTER new_fl_counter(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_counter(COUNTER c);
+
+
+extern "C" double fl_counter_get_step(COUNTER c);
+extern "C" void fl_counter_set_step_top(COUNTER c, double t);
+extern "C" void fl_counter_set_lstep(COUNTER c, double t);
+extern "C" void fl_counter_set_step_both(COUNTER c, double s, double l);
+
+
+extern "C" unsigned int fl_counter_get_textcolor(COUNTER c);
+extern "C" void fl_counter_set_textcolor(COUNTER c, unsigned int t);
+extern "C" int fl_counter_get_textfont(COUNTER c);
+extern "C" void fl_counter_set_textfont(COUNTER c, int t);
+extern "C" int fl_counter_get_textsize(COUNTER c);
+extern "C" void fl_counter_set_textsize(COUNTER c, int t);
+
+
+extern "C" void fl_counter_draw(COUNTER c);
+extern "C" int fl_counter_handle(COUNTER c, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_dial.cpp b/body/c_fl_dial.cpp
new file mode 100644
index 0000000..af83c21
--- /dev/null
+++ b/body/c_fl_dial.cpp
@@ -0,0 +1,119 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Dial.H>
+#include "c_fl_dial.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Dial : Fl_Dial {
+public:
+ // Really only needed for the (int,int,int,int) versions
+ using Fl_Dial::draw;
+ using Fl_Dial::handle;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Dial : public Fl_Dial {
+public:
+ using Fl_Dial::Fl_Dial;
+
+ friend void fl_dial_draw(DIAL v);
+ friend int fl_dial_handle(DIAL v, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Dial::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Dial::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Dial::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+DIAL new_fl_dial(int x, int y, int w, int h, char* label) {
+ My_Dial *v = new My_Dial(x, y, w, h, label);
+ return v;
+}
+
+void free_fl_dial(DIAL v) {
+ delete static_cast<My_Dial*>(v);
+}
+
+
+
+
+short fl_dial_get_angle1(DIAL v) {
+ return static_cast<Fl_Dial*>(v)->angle1();
+}
+
+void fl_dial_set_angle1(DIAL v, short t) {
+ static_cast<Fl_Dial*>(v)->angle1(t);
+}
+
+short fl_dial_get_angle2(DIAL v) {
+ return static_cast<Fl_Dial*>(v)->angle2();
+}
+
+void fl_dial_set_angle2(DIAL v, short t) {
+ static_cast<Fl_Dial*>(v)->angle2(t);
+}
+
+void fl_dial_set_angles(DIAL v, short a, short b) {
+ static_cast<Fl_Dial*>(v)->angles(a,b);
+}
+
+
+
+
+void fl_dial_draw(DIAL v) {
+ static_cast<My_Dial*>(v)->Fl_Dial::draw();
+}
+
+void fl_dial_draw2(DIAL v, int x, int y, int w, int h) {
+ void (Fl_Dial::*mydraw)(int,int,int,int) = &Friend_Dial::draw;
+ (static_cast<Fl_Dial*>(v)->*mydraw)(x, y, w, h);
+}
+
+int fl_dial_handle(DIAL v, int e) {
+ return static_cast<My_Dial*>(v)->Fl_Dial::handle(e);
+}
+
+int fl_dial_handle2(DIAL v, int e, int x, int y, int w, int h) {
+ int (Fl_Dial::*myhandle)(int,int,int,int,int) = &Friend_Dial::handle;
+ return (static_cast<Fl_Dial*>(v)->*myhandle)(e, x, y, w, h);
+}
+
+
diff --git a/body/c_fl_dial.h b/body/c_fl_dial.h
new file mode 100644
index 0000000..b642abd
--- /dev/null
+++ b/body/c_fl_dial.h
@@ -0,0 +1,33 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_DIAL_GUARD
+#define FL_DIAL_GUARD
+
+
+typedef void* DIAL;
+
+
+extern "C" DIAL new_fl_dial(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_dial(DIAL v);
+
+
+extern "C" short fl_dial_get_angle1(DIAL v);
+extern "C" void fl_dial_set_angle1(DIAL v, short t);
+extern "C" short fl_dial_get_angle2(DIAL v);
+extern "C" void fl_dial_set_angle2(DIAL v, short t);
+extern "C" void fl_dial_set_angles(DIAL v, short a, short b);
+
+
+extern "C" void fl_dial_draw(DIAL v);
+extern "C" void fl_dial_draw2(DIAL v, int x, int y, int w, int h);
+extern "C" int fl_dial_handle(DIAL v, int e);
+extern "C" int fl_dial_handle2(DIAL v, int e, int x, int y, int w, int h);
+
+
+#endif
+
+
diff --git a/body/c_fl_display_device.cpp b/body/c_fl_display_device.cpp
new file mode 100644
index 0000000..f4f53bf
--- /dev/null
+++ b/body/c_fl_display_device.cpp
@@ -0,0 +1,29 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Device.H>
+#include "c_fl_display_device.h"
+
+
+
+
+DISPLAYDEVICE new_fl_display_device(void * g) {
+ Fl_Display_Device *d = new Fl_Display_Device(static_cast<Fl_Graphics_Driver*>(g));
+ return d;
+}
+
+void free_fl_display_device(DISPLAYDEVICE d) {
+ delete static_cast<Fl_Display_Device*>(d);
+}
+
+
+
+
+DISPLAYDEVICE fl_display_device_display_device() {
+ return Fl_Display_Device::display_device();
+}
+
+
diff --git a/body/c_fl_display_device.h b/body/c_fl_display_device.h
new file mode 100644
index 0000000..1cf530c
--- /dev/null
+++ b/body/c_fl_display_device.h
@@ -0,0 +1,23 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_DISPLAY_DEVICE_GUARD
+#define FL_DISPLAY_DEVICE_GUARD
+
+
+typedef void* DISPLAYDEVICE;
+
+
+extern "C" DISPLAYDEVICE new_fl_display_device(void * g);
+extern "C" void free_fl_display_device(DISPLAYDEVICE d);
+
+
+extern "C" DISPLAYDEVICE fl_display_device_display_device();
+
+
+#endif
+
+
diff --git a/body/c_fl_double_window.cpp b/body/c_fl_double_window.cpp
new file mode 100644
index 0000000..67db73b
--- /dev/null
+++ b/body/c_fl_double_window.cpp
@@ -0,0 +1,114 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Double_Window.H>
+#include "c_fl_double_window.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Double_Window : Fl_Double_Window {
+public:
+ // Only needed for the (int) version
+ using Fl_Double_Window::flush;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Double_Window : public Fl_Double_Window {
+public:
+ using Fl_Double_Window::Fl_Double_Window;
+
+ friend void fl_double_window_draw(DOUBLEWINDOW n);
+ friend int fl_double_window_handle(DOUBLEWINDOW n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Double_Window::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Double_Window::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+DOUBLEWINDOW new_fl_double_window(int x, int y, int w, int h, char* label) {
+ My_Double_Window *d = new My_Double_Window(x, y, w, h, label);
+ return d;
+}
+
+DOUBLEWINDOW new_fl_double_window2(int w, int h, char* label) {
+ My_Double_Window *d = new My_Double_Window(w, h, label);
+ return d;
+}
+
+void free_fl_double_window(DOUBLEWINDOW d) {
+ delete static_cast<My_Double_Window*>(d);
+}
+
+
+
+
+void fl_double_window_show(DOUBLEWINDOW d) {
+ static_cast<Fl_Double_Window*>(d)->show();
+}
+
+void fl_double_window_show2(DOUBLEWINDOW d, int c, void * v) {
+ static_cast<Fl_Double_Window*>(d)->show(c, static_cast<char**>(v));
+}
+
+void fl_double_window_hide(DOUBLEWINDOW d) {
+ static_cast<Fl_Double_Window*>(d)->hide();
+}
+
+void fl_double_window_flush(DOUBLEWINDOW d) {
+ static_cast<Fl_Double_Window*>(d)->flush();
+}
+
+void fl_double_window_flush2(DOUBLEWINDOW d, int e) {
+ void (Fl_Double_Window::*myflush)(int) = &Friend_Double_Window::flush;
+ (static_cast<Fl_Double_Window*>(d)->*myflush)(e);
+}
+
+
+
+
+void fl_double_window_resize(DOUBLEWINDOW d, int x, int y, int w, int h) {
+ static_cast<Fl_Double_Window*>(d)->resize(x, y, w, h);
+}
+
+
+
+
+void fl_double_window_draw(DOUBLEWINDOW n) {
+ static_cast<My_Double_Window*>(n)->Fl_Double_Window::draw();
+}
+
+int fl_double_window_handle(DOUBLEWINDOW n, int e) {
+ return static_cast<My_Double_Window*>(n)->Fl_Double_Window::handle(e);
+}
+
+
diff --git a/body/c_fl_double_window.h b/body/c_fl_double_window.h
new file mode 100644
index 0000000..c6f4cc8
--- /dev/null
+++ b/body/c_fl_double_window.h
@@ -0,0 +1,35 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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, char* label);
+extern "C" void free_fl_double_window(DOUBLEWINDOW d);
+
+
+extern "C" void fl_double_window_show(DOUBLEWINDOW d);
+extern "C" void fl_double_window_show2(DOUBLEWINDOW d, int c, void * v);
+extern "C" void fl_double_window_hide(DOUBLEWINDOW d);
+extern "C" void fl_double_window_flush(DOUBLEWINDOW d);
+extern "C" void fl_double_window_flush2(DOUBLEWINDOW d, int e);
+
+
+extern "C" void fl_double_window_resize(DOUBLEWINDOW d, int x, int y, int w, int h);
+
+
+extern "C" void fl_double_window_draw(DOUBLEWINDOW n);
+extern "C" int fl_double_window_handle(DOUBLEWINDOW n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_draw.cpp b/body/c_fl_draw.cpp
new file mode 100644
index 0000000..488a73f
--- /dev/null
+++ b/body/c_fl_draw.cpp
@@ -0,0 +1,447 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/fl_draw.H>
+#include <FL/Fl_Window.H>
+#include "c_fl_draw.h"
+
+
+
+
+void fl_draw_reset_spot() {
+ fl_reset_spot();
+}
+
+void fl_draw_set_spot(int f, int s, int x, int y, int w, int h, void * ptr) {
+ fl_set_spot(f, s, x, y, w, h, static_cast<Fl_Window*>(ptr));
+}
+
+void fl_draw_set_status(int x, int y, int w, int h) {
+ fl_set_status(x, y, w, h);
+}
+
+
+
+
+int fl_draw_can_do_alpha_blending() {
+ return fl_can_do_alpha_blending();
+}
+
+const char * fl_draw_shortcut_label(unsigned int shortcut) {
+ return fl_shortcut_label(shortcut);
+}
+
+
+
+
+const char * fl_draw_latin1_to_local(const char *t, int n) {
+ return fl_latin1_to_local(t, n);
+}
+
+const char * fl_draw_local_to_latin1(const char *t, int n) {
+ return fl_local_to_latin1(t, n);
+}
+
+const char * fl_draw_mac_roman_to_local(const char *t, int n) {
+ return fl_mac_roman_to_local(t, n);
+}
+
+const char * fl_draw_local_to_mac_roman(const char *t, int n) {
+ return fl_local_to_mac_roman(t, n);
+}
+
+
+
+
+int fl_draw_clip_box(int x, int y, int w, int h, int &bx, int &by, int &bw, int &bh) {
+ return fl_clip_box(x, y, w, h, bx, by, bw, bh);
+}
+
+int fl_draw_not_clipped(int x, int y, int w, int h) {
+ return fl_not_clipped(x, y, w, h);
+}
+
+void fl_draw_pop_clip() {
+ fl_pop_clip();
+}
+
+void fl_draw_push_clip(int x, int y, int w, int h) {
+ fl_push_clip(x, y, w, h);
+}
+
+void fl_draw_push_no_clip() {
+ fl_push_no_clip();
+}
+
+void fl_draw_restore_clip() {
+ fl_restore_clip();
+}
+
+
+
+
+void fl_draw_overlay_clear() {
+ fl_overlay_clear();
+}
+
+void fl_draw_overlay_rect(int x, int y, int w, int h) {
+ fl_overlay_rect(x, y, w, h);
+}
+
+
+
+
+unsigned int fl_draw_get_color() {
+ return fl_color();
+}
+
+void fl_draw_set_color(unsigned int c) {
+ fl_color(c);
+}
+
+void fl_draw_set_color2(uchar r, uchar g, uchar b) {
+ fl_color(r, g, b);
+}
+
+void fl_draw_set_cursor(int m) {
+ fl_cursor((Fl_Cursor)m);
+}
+
+void fl_draw_set_cursor2(int m, unsigned int f, unsigned int b) {
+ fl_cursor((Fl_Cursor)m, f, b);
+}
+
+unsigned int fl_draw_get_font() {
+ return (unsigned int)fl_font();
+}
+
+int fl_draw_size() {
+ return fl_size();
+}
+
+void fl_draw_set_font(unsigned int f, int s) {
+ fl_font((Fl_Font)f, (Fl_Fontsize)s);
+}
+
+int fl_draw_height() {
+ return fl_height();
+}
+
+int fl_draw_descent() {
+ return fl_descent();
+}
+
+int fl_draw_height2(unsigned int f, int s) {
+ return fl_height(f, s);
+}
+
+void fl_draw_line_style(int style, int width, char * dashes) {
+ fl_line_style(style, width, dashes);
+}
+
+
+
+
+void fl_draw_mult_matrix(double a, double b, double c, double d, double x, double y) {
+ fl_mult_matrix(a, b, c, d, x, y);
+}
+
+void fl_draw_pop_matrix() {
+ fl_pop_matrix();
+}
+
+void fl_draw_push_matrix() {
+ fl_push_matrix();
+}
+
+void fl_draw_rotate(double d) {
+ fl_rotate(d);
+}
+
+void fl_draw_scale(double x) {
+ fl_scale(x);
+}
+
+void fl_draw_scale2(double x, double y) {
+ fl_scale(x, y);
+}
+
+double fl_draw_transform_dx(double x, double y) {
+ return fl_transform_dx(x, y);
+}
+
+double fl_draw_transform_dy(double x, double y) {
+ return fl_transform_dy(x, y);
+}
+
+double fl_draw_transform_x(double x, double y) {
+ return fl_transform_x(x, y);
+}
+
+double fl_draw_transform_y(double x, double y) {
+ return fl_transform_y(x, y);
+}
+
+void fl_draw_transformed_vertex(double xf, double yf) {
+ fl_transformed_vertex(xf, yf);
+}
+
+void fl_draw_translate(double x, double y) {
+ fl_translate(x, y);
+}
+
+void fl_draw_vertex(double x, double y) {
+ fl_vertex(x, y);
+}
+
+
+
+
+void fl_draw_draw_image(void * data, int x, int y, int w, int h, int d, int l) {
+ fl_draw_image(static_cast<uchar*>(data), x, y, w, h, d, l);
+}
+
+void fl_draw_draw_image2(void * func, void * data, int x, int y, int w, int h, int d) {
+ fl_draw_image(reinterpret_cast<Fl_Draw_Image_Cb>(func), data, x, y, w, h, d);
+}
+
+void fl_draw_draw_image_mono(void * data, int x, int y, int w, int h, int d, int l) {
+ fl_draw_image_mono(static_cast<uchar*>(data), x, y, w, h, d, l);
+}
+
+void fl_draw_draw_image_mono2(void * func, void * data, int x, int y, int w, int h, int d) {
+ fl_draw_image_mono(reinterpret_cast<Fl_Draw_Image_Cb>(func), data, x, y, w, h, d);
+}
+
+void * fl_draw_read_image(void * data, int x, int y, int w, int h, int alpha) {
+ return fl_read_image(static_cast<uchar*>(data), x, y, w, h, alpha);
+}
+
+
+
+
+typedef void (sym_hook)(Fl_Color);
+typedef sym_hook* sym_hook_p;
+
+int fl_draw_add_symbol(const char *name, void *func, int scalable) {
+ return fl_add_symbol(name, reinterpret_cast<sym_hook_p>(func), scalable);
+}
+
+void fl_draw_draw_text(const char *str, int n, int x, int y) {
+ fl_draw(str, n, x, y);
+}
+
+void fl_draw_draw_text2(const char *str, int x, int y, int w, int h,
+ unsigned align, void * img, int draw_symbols) {
+ fl_draw(str, x, y, w, h, (Fl_Align)align, (Fl_Image*)img, draw_symbols);
+}
+
+typedef void (t_hook)(const char *, int ,int ,int);
+typedef t_hook* t_hook_p;
+
+void fl_draw_draw_text3(const char *str, int x, int y, int w, int h,
+ unsigned align, void * func, void * img, int draw_symbols) {
+ fl_draw(str, x, y, w, h, (Fl_Align)align,
+ reinterpret_cast<t_hook_p>(func), (Fl_Image*)img, draw_symbols);
+}
+
+void fl_draw_draw_text4(int angle, const char *str, int n, int x, int y) {
+ fl_draw(angle, str, n, x, y);
+}
+
+void fl_draw_rtl_draw(const char *str, int n, int x, int y) {
+ fl_rtl_draw(str, n, x, y);
+}
+
+void fl_draw_draw_box(int bk, int x, int y, int w, int h, unsigned int c) {
+ fl_draw_box((Fl_Boxtype)bk, x, y, w, h, (Fl_Color)c);
+}
+
+void fl_draw_draw_symbol(const char *label, int x, int y, int w, int h, unsigned int c) {
+ fl_draw_symbol(label, x, y, w, h, (Fl_Color)c);
+}
+
+void fl_draw_measure(const char * str, int &w, int &h, int draw_symbols) {
+ fl_measure(str, w, h, draw_symbols);
+}
+
+typedef void (a_hook)(void *, int, int, int, int);
+typedef a_hook* a_hook_p;
+
+void fl_draw_scroll(int x, int y, int w, int h, int dx, int dy,
+ void * func, void * data) {
+ fl_scroll(x, y, w, h, dx, dy, reinterpret_cast<a_hook_p>(func), data);
+}
+
+void fl_draw_text_extents(const char * t, int n, int &dx, int &dy, int &w, int &h) {
+ fl_text_extents(t, n, dx, dy, w, h);
+}
+
+double fl_draw_width(const char *txt, int n) {
+ return fl_width(txt, n);
+}
+
+double fl_draw_width2(unsigned long c) {
+ return fl_width(c);
+}
+
+
+
+
+void fl_draw_begin_complex_polygon() {
+ fl_begin_complex_polygon();
+}
+
+void fl_draw_begin_line() {
+ fl_begin_line();
+}
+
+void fl_draw_begin_loop() {
+ fl_begin_loop();
+}
+
+void fl_draw_begin_points() {
+ fl_begin_points();
+}
+
+void fl_draw_begin_polygon() {
+ fl_begin_polygon();
+}
+
+
+
+
+void fl_draw_arc(double x, double y, double r, double start, double end) {
+ fl_arc(x, y, r, start, end);
+}
+
+void fl_draw_arc2(int x, int y, int w, int h, double a1, double a2) {
+ fl_arc(x, y, w, h, a1, a2);
+}
+
+// function does not yet exist
+// void fl_draw_chord(int x, int y, int w, int h, double a1, double a2) {
+// function does not yet exist
+// fl_chord(x, y, w, h, a1, a2);
+// }
+
+void fl_draw_circle(double x, double y, double r) {
+ fl_circle(x, y, r);
+}
+
+void fl_draw_curve(double x0, double y0, double x1, double y1,
+ double x2, double y2, double x3, double y3) {
+ fl_curve(x0, y0, x1, y1, x2, y2, x3, y3);
+}
+
+void fl_draw_frame(const char *s, int x, int y, int w, int h) {
+ fl_frame(s, x, y, w, h);
+}
+
+void fl_draw_gap() {
+ fl_gap();
+}
+
+void fl_draw_line(int x0, int y0, int x1, int y1) {
+ fl_line(x0, y0, x1, y1);
+}
+
+void fl_draw_line2(int x0, int y0, int x1, int y1, int x2, int y2) {
+ fl_line(x0, y0, x1, y1, x2, y2);
+}
+
+void fl_draw_loop(int x0, int y0, int x1, int y1, int x2, int y2) {
+ fl_loop(x0, y0, x1, y1, x2, y2);
+}
+
+void fl_draw_loop2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3) {
+ fl_loop(x0, y0, x1, y1, x2, y2, x3, y3);
+}
+
+void fl_draw_pie(int x, int y, int w, int h, double a1, double a2) {
+ fl_pie(x, y, w, h, a1, a2);
+}
+
+void fl_draw_point(int x, int y) {
+ fl_point(x, y);
+}
+
+void fl_draw_polygon(int x0, int y0, int x1, int y1, int x2, int y2) {
+ fl_polygon(x0, y0, x1, y1, x2, y2);
+}
+
+void fl_draw_polygon2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3) {
+ fl_polygon(x0, y0, x1, y1, x2, y2, x3, y3);
+}
+
+void fl_draw_rect(int x, int y, int w, int h) {
+ fl_rect(x, y, w, h);
+}
+
+void fl_draw_rect2(int x, int y, int w, int h, unsigned int c) {
+ fl_rect(x, y, w, h, c);
+}
+
+void fl_draw_rect_fill(int x, int y, int w, int h) {
+ fl_rectf(x, y, w, h);
+}
+
+void fl_draw_rect_fill2(int x, int y, int w, int h, unsigned int c) {
+ fl_rectf(x, y, w, h, (Fl_Color)c);
+}
+
+void fl_draw_rect_fill3(int x, int y, int w, int h, uchar r, uchar g, uchar b) {
+ fl_rectf(x, y, w, h, r, g, b);
+}
+
+void fl_draw_xy_line(int x0, int y0, int x1) {
+ fl_xyline(x0, y0, x1);
+}
+
+void fl_draw_xy_line2(int x0, int y0, int x1, int y2) {
+ fl_xyline(x0, y0, x1, y2);
+}
+
+void fl_draw_xy_line3(int x0, int y0, int x1, int y2, int x3) {
+ fl_xyline(x0, y0, x1, y2, x3);
+}
+
+void fl_draw_yx_line(int x0, int y0, int y1) {
+ fl_yxline(x0, y0, y1);
+}
+
+void fl_draw_yx_line2(int x0, int y0, int y1, int x2) {
+ fl_yxline(x0, y0, y1, x2);
+}
+
+void fl_draw_yx_line3(int x0, int y0, int y1, int x2, int y3) {
+ fl_yxline(x0, y0, y1, x2, y3);
+}
+
+
+
+
+void fl_draw_end_complex_polygon() {
+ fl_end_complex_polygon();
+}
+
+void fl_draw_end_line() {
+ fl_end_line();
+}
+
+void fl_draw_end_loop() {
+ fl_end_loop();
+}
+
+void fl_draw_end_points() {
+ fl_end_points();
+}
+
+void fl_draw_end_polygon() {
+ fl_end_polygon();
+}
+
+
diff --git a/body/c_fl_draw.h b/body/c_fl_draw.h
new file mode 100644
index 0000000..d719903
--- /dev/null
+++ b/body/c_fl_draw.h
@@ -0,0 +1,137 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_DRAW_GUARD
+#define FL_DRAW_GUARD
+
+
+extern "C" void fl_draw_reset_spot();
+extern "C" void fl_draw_set_spot(int f, int s, int x, int y, int w, int h, void * ptr);
+extern "C" void fl_draw_set_status(int x, int y, int w, int h);
+
+
+extern "C" int fl_draw_can_do_alpha_blending();
+extern "C" const char * fl_draw_shortcut_label(unsigned int shortcut);
+
+
+extern "C" const char * fl_draw_latin1_to_local(const char *t, int n);
+extern "C" const char * fl_draw_local_to_latin1(const char *t, int n);
+extern "C" const char * fl_draw_mac_roman_to_local(const char *t, int n);
+extern "C" const char * fl_draw_local_to_mac_roman(const char *t, int n);
+
+
+extern "C" int fl_draw_clip_box(int x, int y, int w, int h, int &bx, int &by, int &bw, int &bh);
+extern "C" int fl_draw_not_clipped(int x, int y, int w, int h);
+extern "C" void fl_draw_pop_clip();
+extern "C" void fl_draw_push_clip(int x, int y, int w, int h);
+extern "C" void fl_draw_push_no_clip();
+extern "C" void fl_draw_restore_clip();
+
+
+extern "C" void fl_draw_overlay_clear();
+extern "C" void fl_draw_overlay_rect(int x, int y, int w, int h);
+
+
+extern "C" unsigned int fl_draw_get_color();
+extern "C" void fl_draw_set_color(unsigned int c);
+extern "C" void fl_draw_set_color2(uchar r, uchar g, uchar b);
+extern "C" void fl_draw_set_cursor(int m);
+extern "C" void fl_draw_set_cursor2(int m, unsigned int f, unsigned int b);
+extern "C" unsigned int fl_draw_get_font();
+extern "C" int fl_draw_size();
+extern "C" void fl_draw_set_font(unsigned int f, int s);
+extern "C" int fl_draw_height();
+extern "C" int fl_draw_descent();
+extern "C" int fl_draw_height2(unsigned int f, int s);
+extern "C" void fl_draw_line_style(int style, int width, char * dashes);
+
+
+extern "C" void fl_draw_mult_matrix(double a, double b, double c, double d, double x, double y);
+extern "C" void fl_draw_pop_matrix();
+extern "C" void fl_draw_push_matrix();
+extern "C" void fl_draw_rotate(double d);
+extern "C" void fl_draw_scale(double x);
+extern "C" void fl_draw_scale2(double x, double y);
+extern "C" double fl_draw_transform_dx(double x, double y);
+extern "C" double fl_draw_transform_dy(double x, double y);
+extern "C" double fl_draw_transform_x(double x, double y);
+extern "C" double fl_draw_transform_y(double x, double y);
+extern "C" void fl_draw_transformed_vertex(double xf, double yf);
+extern "C" void fl_draw_translate(double x, double y);
+extern "C" void fl_draw_vertex(double x, double y);
+
+
+extern "C" void fl_draw_draw_image(void * data, int x, int y, int w, int h, int d, int l);
+extern "C" void fl_draw_draw_image2(void * func, void * data, int x, int y, int w, int h, int d);
+extern "C" void fl_draw_draw_image_mono(void * data, int x, int y, int w, int h, int d, int l);
+extern "C" void fl_draw_draw_image_mono2(void * func, void * data, int x, int y, int w, int h, int d);
+extern "C" void * fl_draw_read_image(void * data, int x, int y, int w, int h, int alpha);
+
+
+extern "C" int fl_draw_add_symbol(const char *name, void *func, int scalable);
+extern "C" void fl_draw_draw_text(const char *str, int n, int x, int y);
+extern "C" void fl_draw_draw_text2(const char *str, int x, int y, int w, int h,
+ unsigned align, void * img, int draw_symbols);
+extern "C" void fl_draw_draw_text3(const char *str, int x, int y, int w, int h,
+ unsigned align, void * func, void * img, int draw_symbols);
+extern "C" void fl_draw_draw_text4(int angle, const char *str, int n, int x, int y);
+extern "C" void fl_draw_rtl_draw(const char *str, int n, int x, int y);
+extern "C" void fl_draw_draw_box(int bk, int x, int y, int w, int h, unsigned int c);
+extern "C" void fl_draw_draw_symbol(const char *label, int x, int y, int w, int h, unsigned int c);
+extern "C" void fl_draw_measure(const char * str, int &w, int &h, int draw_symbols);
+extern "C" void fl_draw_scroll(int x, int y, int w, int h, int dx, int dy,
+ void * func, void * data);
+extern "C" void fl_draw_text_extents(const char * t, int n, int &dx, int &dy, int &w, int &h);
+extern "C" double fl_draw_width(const char *txt, int n);
+extern "C" double fl_draw_width2(unsigned long c);
+
+
+extern "C" void fl_draw_begin_complex_polygon();
+extern "C" void fl_draw_begin_line();
+extern "C" void fl_draw_begin_loop();
+extern "C" void fl_draw_begin_points();
+extern "C" void fl_draw_begin_polygon();
+
+
+extern "C" void fl_draw_arc(double x, double y, double r, double start, double end);
+extern "C" void fl_draw_arc2(int x, int y, int w, int h, double a1, double a2);
+// extern "C" void fl_draw_chord(int x, int y, int w, int h, double a1, double a2);
+extern "C" void fl_draw_circle(double x, double y, double r);
+extern "C" void fl_draw_curve(double x0, double y0, double x1, double y1,
+ double x2, double y2, double x3, double y3);
+extern "C" void fl_draw_frame(const char *s, int x, int y, int w, int h);
+extern "C" void fl_draw_gap();
+extern "C" void fl_draw_line(int x0, int y0, int x1, int y1);
+extern "C" void fl_draw_line2(int x0, int y0, int x1, int y1, int x2, int y2);
+extern "C" void fl_draw_loop(int x0, int y0, int x1, int y1, int x2, int y2);
+extern "C" void fl_draw_loop2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3);
+extern "C" void fl_draw_pie(int x, int y, int w, int h, double a1, double a2);
+extern "C" void fl_draw_point(int x, int y);
+extern "C" void fl_draw_polygon(int x0, int y0, int x1, int y1, int x2, int y2);
+extern "C" void fl_draw_polygon2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3);
+extern "C" void fl_draw_rect(int x, int y, int w, int h);
+extern "C" void fl_draw_rect2(int x, int y, int w, int h, unsigned int c);
+extern "C" void fl_draw_rect_fill(int x, int y, int w, int h);
+extern "C" void fl_draw_rect_fill2(int x, int y, int w, int h, unsigned int c);
+extern "C" void fl_draw_rect_fill3(int x, int y, int w, int h, uchar r, uchar g, uchar b);
+extern "C" void fl_draw_xy_line(int x0, int y0, int x1);
+extern "C" void fl_draw_xy_line2(int x0, int y0, int x1, int y2);
+extern "C" void fl_draw_xy_line3(int x0, int y0, int x1, int y2, int x3);
+extern "C" void fl_draw_yx_line(int x0, int y0, int y1);
+extern "C" void fl_draw_yx_line2(int x0, int y0, int y1, int x2);
+extern "C" void fl_draw_yx_line3(int x0, int y0, int y1, int x2, int y3);
+
+
+extern "C" void fl_draw_end_complex_polygon();
+extern "C" void fl_draw_end_line();
+extern "C" void fl_draw_end_loop();
+extern "C" void fl_draw_end_points();
+extern "C" void fl_draw_end_polygon();
+
+
+#endif
+
+
diff --git a/body/c_fl_error.cpp b/body/c_fl_error.cpp
new file mode 100644
index 0000000..e38481a
--- /dev/null
+++ b/body/c_fl_error.cpp
@@ -0,0 +1,98 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl.H>
+#include <errno.h>
+#include <stdarg.h>
+#include <string.h>
+#include "c_fl_error.h"
+
+
+
+
+// Obtaining general error messages from errno
+
+char * get_error_message() {
+ return strerror(errno);
+}
+
+
+
+
+// Exports from Ada
+
+extern "C" void error_warning_hook(const char * m);
+extern "C" void error_error_hook(const char * m);
+extern "C" void error_fatal_hook(const char * m);
+
+
+// This is the size used internally in FLTK anyway
+const int error_bsize = 1024;
+
+
+// Some prep needed to convert vargs to a single char*
+
+void warning_hook_prep(const char * m, ...) {
+ va_list args;
+ char buf[error_bsize];
+ va_start(args, m);
+ vsnprintf(buf, error_bsize, m, args);
+ va_end(args);
+ error_warning_hook(buf);
+}
+
+void error_hook_prep(const char * m, ...) {
+ va_list args;
+ char buf[error_bsize];
+ va_start(args, m);
+ vsnprintf(buf, error_bsize, m, args);
+ va_end(args);
+ error_error_hook(buf);
+}
+
+void fatal_hook_prep(const char * m, ...) {
+ va_list args;
+ char buf[error_bsize];
+ va_start(args, m);
+ vsnprintf(buf, error_bsize, m, args);
+ va_end(args);
+ error_fatal_hook(buf);
+}
+
+
+
+
+// Original function pointers
+
+void (*original_warning)(const char *, ...) = Fl::warning;
+void (*original_error)(const char *, ...) = Fl::error;
+void (*original_fatal)(const char *, ...) = Fl::fatal;
+
+
+void fl_error_default_warning(const char * m) {
+ (*original_warning)(m);
+}
+
+void fl_error_default_error(const char * m) {
+ (*original_error)(m);
+}
+
+void fl_error_default_fatal(const char * m) {
+ (*original_fatal)(m);
+}
+
+
+
+
+// Tying it all together
+
+void fl_error_set_hooks() {
+ Fl::warning = &warning_hook_prep;
+ Fl::error = &error_hook_prep;
+ Fl::fatal = &fatal_hook_prep;
+}
+
+
diff --git a/body/c_fl_error.h b/body/c_fl_error.h
new file mode 100644
index 0000000..1d4bc76
--- /dev/null
+++ b/body/c_fl_error.h
@@ -0,0 +1,27 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_ERROR_GUARD
+#define FL_ERROR_GUARD
+
+
+extern "C" char * get_error_message();
+
+
+extern "C" const int error_bsize;
+
+
+extern "C" void fl_error_default_warning(const char * m);
+extern "C" void fl_error_default_error(const char * m);
+extern "C" void fl_error_default_fatal(const char * m);
+
+
+extern "C" void fl_error_set_hooks();
+
+
+#endif
+
+
diff --git a/body/c_fl_event.cpp b/body/c_fl_event.cpp
new file mode 100644
index 0000000..59a22df
--- /dev/null
+++ b/body/c_fl_event.cpp
@@ -0,0 +1,194 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl.H>
+#include <FL/Fl_Widget.H>
+#include <FL/Fl_Window.H>
+#include "c_fl_event.h"
+
+
+
+
+void fl_event_add_handler(void * f) {
+ Fl::add_handler(reinterpret_cast<Fl_Event_Handler>(f));
+}
+
+void fl_event_set_event_dispatch(void * f) {
+ Fl::event_dispatch(reinterpret_cast<Fl_Event_Dispatch>(f));
+}
+
+int fl_event_handle(int e, void * w) {
+ return Fl::handle_(e, static_cast<Fl_Window*>(w));
+}
+
+
+
+
+void * fl_event_get_grab() {
+ return Fl::grab();
+}
+
+void fl_event_set_grab(void * w) {
+ Fl::grab(static_cast<Fl_Window*>(w));
+}
+
+void * fl_event_get_pushed() {
+ return Fl::pushed();
+}
+
+void fl_event_set_pushed(void * w) {
+ Fl::pushed(static_cast<Fl_Widget*>(w));
+}
+
+void * fl_event_get_belowmouse() {
+ return Fl::belowmouse();
+}
+
+void fl_event_set_belowmouse(void * w) {
+ Fl::belowmouse(static_cast<Fl_Widget*>(w));
+}
+
+void * fl_event_get_focus() {
+ return Fl::focus();
+}
+
+void fl_event_set_focus(void * w) {
+ Fl::focus(static_cast<Fl_Widget*>(w));
+}
+
+
+
+
+int fl_event_compose(int &d) {
+ return Fl::compose(d);
+}
+
+void fl_event_compose_reset() {
+ Fl::compose_reset();
+}
+
+const char * fl_event_text() {
+ return Fl::event_text();
+}
+
+int fl_event_length() {
+ return Fl::event_length();
+}
+
+
+
+
+int fl_event_get() {
+ return Fl::event();
+}
+
+int fl_event_state() {
+ return Fl::event_state();
+}
+
+int fl_event_check_state(int s) {
+ return Fl::event_state(s);
+}
+
+
+
+
+int fl_event_x() {
+ return Fl::event_x();
+}
+
+int fl_event_x_root() {
+ return Fl::event_x_root();
+}
+
+int fl_event_y() {
+ return Fl::event_y();
+}
+
+int fl_event_y_root() {
+ return Fl::event_y_root();
+}
+
+int fl_event_dx() {
+ return Fl::event_dx();
+}
+
+int fl_event_dy() {
+ return Fl::event_dy();
+}
+
+void fl_event_get_mouse(int &x, int &y) {
+ Fl::get_mouse(x, y);
+}
+
+int fl_event_is_click() {
+ return Fl::event_is_click();
+}
+
+int fl_event_is_clicks() {
+ return Fl::event_clicks();
+}
+
+void fl_event_set_clicks(int c) {
+ Fl::event_clicks(c);
+}
+
+int fl_event_button() {
+ return Fl::event_button();
+}
+
+int fl_event_button1() {
+ return Fl::event_button1();
+}
+
+int fl_event_button2() {
+ return Fl::event_button2();
+}
+
+int fl_event_button3() {
+ return Fl::event_button3();
+}
+
+int fl_event_inside(int x, int y, int w, int h) {
+ return Fl::event_inside(x, y, w, h);
+}
+
+
+
+
+int fl_event_key() {
+ return Fl::event_key();
+}
+
+int fl_event_original_key() {
+ return Fl::event_original_key();
+}
+
+int fl_event_key_during(int k) {
+ return Fl::event_key(k);
+}
+
+int fl_event_get_key(int k) {
+ return Fl::get_key(k);
+}
+
+int fl_event_ctrl() {
+ return Fl::event_ctrl();
+}
+
+int fl_event_alt() {
+ return Fl::event_alt();
+}
+
+int fl_event_command() {
+ return Fl::event_command();
+}
+
+int fl_event_shift() {
+ return Fl::event_shift();
+}
+
+
diff --git a/body/c_fl_event.h b/body/c_fl_event.h
new file mode 100644
index 0000000..cc1f930
--- /dev/null
+++ b/body/c_fl_event.h
@@ -0,0 +1,66 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_EVENT_GUARD
+#define FL_EVENT_GUARD
+
+
+extern "C" void fl_event_add_handler(void * f);
+extern "C" void fl_event_set_event_dispatch(void * f);
+extern "C" int fl_event_handle(int e, void * w);
+
+
+extern "C" void * fl_event_get_grab();
+extern "C" void fl_event_set_grab(void * w);
+extern "C" void * fl_event_get_pushed();
+extern "C" void fl_event_set_pushed(void * w);
+extern "C" void * fl_event_get_belowmouse();
+extern "C" void fl_event_set_belowmouse(void * w);
+extern "C" void * fl_event_get_focus();
+extern "C" void fl_event_set_focus(void * w);
+
+
+extern "C" int fl_event_compose(int &d);
+extern "C" void fl_event_compose_reset();
+extern "C" const char * fl_event_text();
+extern "C" int fl_event_length();
+
+
+extern "C" int fl_event_get();
+extern "C" int fl_event_state();
+extern "C" int fl_event_check_state(int s);
+
+
+extern "C" int fl_event_x();
+extern "C" int fl_event_x_root();
+extern "C" int fl_event_y();
+extern "C" int fl_event_y_root();
+extern "C" int fl_event_dx();
+extern "C" int fl_event_dy();
+extern "C" void fl_event_get_mouse(int &x, int &y);
+extern "C" int fl_event_is_click();
+extern "C" int fl_event_is_clicks();
+extern "C" void fl_event_set_clicks(int c);
+extern "C" int fl_event_button();
+extern "C" int fl_event_button1();
+extern "C" int fl_event_button2();
+extern "C" int fl_event_button3();
+extern "C" int fl_event_inside(int x, int y, int w, int h);
+
+
+extern "C" int fl_event_key();
+extern "C" int fl_event_original_key();
+extern "C" int fl_event_key_during(int k);
+extern "C" int fl_event_get_key(int k);
+extern "C" int fl_event_ctrl();
+extern "C" int fl_event_alt();
+extern "C" int fl_event_command();
+extern "C" int fl_event_shift();
+
+
+#endif
+
+
diff --git a/body/c_fl_file_browser.cpp b/body/c_fl_file_browser.cpp
new file mode 100644
index 0000000..2e4f4c9
--- /dev/null
+++ b/body/c_fl_file_browser.cpp
@@ -0,0 +1,331 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_File_Browser.H>
+#include <FL/Fl_Browser.H>
+#include <FL/filename.H>
+#include "c_fl_file_browser.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" int browser_full_width_hook(void * b);
+// extern "C" int browser_full_height_hook(void * b);
+// extern "C" int browser_incr_height_hook(void * b);
+extern "C" int browser_item_quick_height_hook(void * b, void * i);
+
+// extern "C" int browser_item_width_hook(void * b, void * i);
+// extern "C" int browser_item_height_hook(void * b, void * i);
+extern "C" void * browser_item_first_hook(void * b);
+extern "C" void * browser_item_last_hook(void * b);
+extern "C" void * browser_item_next_hook(void * b, void * i);
+extern "C" void * browser_item_prev_hook(void * b, void * i);
+extern "C" void * browser_item_at_hook(void * b, int n);
+extern "C" void browser_item_select_hook(void * b, void * i, int s);
+extern "C" int browser_item_selected_hook(void * b, void * i);
+extern "C" void browser_item_swap_hook(void * b, void * one, void * two);
+extern "C" const char * browser_item_text_hook(void * b, void * i);
+// extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h);
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected / private access
+
+// Should check these in future versions of FLTK to see whether
+// it is possible to change them back to being overridden properly.
+
+class Friend_Browser : Fl_Browser {
+public:
+ using Fl_Browser::full_height;
+ using Fl_Browser::incr_height;
+ using Fl_Browser::item_width;
+ using Fl_Browser::item_height;
+ using Fl_Browser::item_draw;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_File_Browser : public Fl_File_Browser {
+public:
+ using Fl_File_Browser::Fl_File_Browser;
+
+ friend int fl_file_browser_item_width(FILEBROWSER b, void * item);
+ friend int fl_file_browser_item_height(FILEBROWSER b, void * item);
+ friend void * fl_file_browser_item_first(FILEBROWSER b);
+ friend void * fl_file_browser_item_last(FILEBROWSER b);
+ friend void * fl_file_browser_item_next(FILEBROWSER b, void * item);
+ friend void * fl_file_browser_item_prev(FILEBROWSER b, void * item);
+ friend void * fl_file_browser_item_at(FILEBROWSER b, int index);
+ friend void fl_file_browser_item_select(FILEBROWSER b, void * item, int val);
+ friend int fl_file_browser_item_selected(FILEBROWSER b, void * item);
+ friend void fl_file_browser_item_swap(FILEBROWSER b, void * x, void * y);
+ friend const char * fl_file_browser_item_text(FILEBROWSER b, void * item);
+ friend void fl_file_browser_item_draw(FILEBROWSER b, void * item, int x, int y, int w, int h);
+
+ friend int fl_file_browser_full_width(FILEBROWSER c);
+ friend int fl_file_browser_full_height(FILEBROWSER c);
+ friend int fl_file_browser_incr_height(FILEBROWSER c);
+ friend int fl_file_browser_item_quick_height(FILEBROWSER c, void * i);
+
+ friend void fl_file_browser_draw(FILEBROWSER b);
+
+ int handle(int e);
+
+protected:
+ int full_width() const;
+ // int full_height() const;
+ // int incr_height() const;
+ int item_quick_height(void * item) const;
+
+ // int item_width(void * item) const;
+ // int item_height(void * item) const;
+ void * item_first() const;
+ void * item_last() const;
+ void * item_next(void * item) const;
+ void * item_prev(void * item) const;
+ void * item_at(int index) const;
+ void item_select(void * item, int val=1);
+ int item_selected(void * item) const;
+ void item_swap(void * a, void * b);
+ const char * item_text(void * item) const;
+ // void item_draw(void * item, int x, int y, int w, int h) const;
+
+ void draw();
+};
+
+
+int My_File_Browser::full_width() const {
+ return browser_full_width_hook(this->user_data());
+}
+
+// int My_File_Browser::full_height() const {
+// return browser_full_height_hook(this->user_data());
+// }
+
+// int My_File_Browser::incr_height() const {
+// return browser_incr_height_hook(this->user_data());
+// }
+
+int My_File_Browser::item_quick_height(void * item) const {
+ return browser_item_quick_height_hook(this->user_data(), item);
+}
+
+
+// int My_File_Browser::item_width(void * item) const {
+// return browser_item_width_hook(this->user_data(), item);
+// }
+
+// int My_File_Browser::item_height(void * item) const {
+// return browser_item_height_hook(this->user_data(), item);
+// }
+
+void * My_File_Browser::item_first() const {
+ return browser_item_first_hook(this->user_data());
+}
+
+void * My_File_Browser::item_last() const {
+ return browser_item_last_hook(this->user_data());
+}
+
+void * My_File_Browser::item_next(void * item) const {
+ return browser_item_next_hook(this->user_data(), item);
+}
+
+void * My_File_Browser::item_prev(void * item) const {
+ return browser_item_prev_hook(this->user_data(), item);
+}
+
+void * My_File_Browser::item_at(int index) const {
+ return browser_item_at_hook(this->user_data(), index);
+}
+
+void My_File_Browser::item_select(void * item, int val) {
+ browser_item_select_hook(this->user_data(), item, val);
+}
+
+int My_File_Browser::item_selected(void * item) const {
+ return browser_item_selected_hook(this->user_data(), item);
+}
+
+void My_File_Browser::item_swap(void * a, void * b) {
+ browser_item_swap_hook(this->user_data(), a, b);
+}
+
+const char * My_File_Browser::item_text(void * item) const {
+ return browser_item_text_hook(this->user_data(), item);
+}
+
+// void My_File_Browser::item_draw(void * item, int x, int y, int w, int h) const {
+// browser_item_draw_hook(this->user_data(), item, x, y, w, h);
+// }
+
+
+void My_File_Browser::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_File_Browser::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API begins here
+
+FILEBROWSER new_fl_file_browser(int x, int y, int w, int h, char * label) {
+ My_File_Browser *b = new My_File_Browser(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_file_browser(FILEBROWSER b) {
+ delete static_cast<My_File_Browser*>(b);
+}
+
+
+
+
+int fl_file_browser_load(FILEBROWSER b, const char * d, void * s) {
+ return static_cast<Fl_File_Browser*>(b)->load(d, reinterpret_cast<Fl_File_Sort_F*>(s));
+}
+
+
+
+
+int fl_file_browser_get_filetype(FILEBROWSER b) {
+ return static_cast<Fl_File_Browser*>(b)->filetype();
+}
+
+void fl_file_browser_set_filetype(FILEBROWSER b, int f) {
+ static_cast<Fl_File_Browser*>(b)->filetype(f);
+}
+
+const char * fl_file_browser_get_filter(FILEBROWSER b) {
+ return static_cast<Fl_File_Browser*>(b)->filter();
+}
+
+void fl_file_browser_set_filter(FILEBROWSER b, const char * f) {
+ static_cast<Fl_File_Browser*>(b)->filter(f);
+}
+
+unsigned char fl_file_browser_get_iconsize(FILEBROWSER b) {
+ return static_cast<Fl_File_Browser*>(b)->iconsize();
+}
+
+void fl_file_browser_set_iconsize(FILEBROWSER b, unsigned int i) {
+ static_cast<Fl_File_Browser*>(b)->iconsize(i);
+}
+
+int fl_file_browser_get_textsize(FILEBROWSER b) {
+ return static_cast<Fl_File_Browser*>(b)->textsize();
+}
+
+void fl_file_browser_set_textsize(FILEBROWSER b, int s) {
+ static_cast<Fl_File_Browser*>(b)->textsize(s);
+}
+
+
+
+
+// These have to be reimplemented due to relying on custom class extensions
+
+
+int fl_file_browser_full_height(FILEBROWSER c) {
+ // return static_cast<My_File_Browser*>(c)->Fl_File_Browser::full_height();
+ return (static_cast<Fl_File_Browser*>(c)->*(&Friend_Browser::full_height))();
+}
+
+int fl_file_browser_incr_height(FILEBROWSER c) {
+ // return static_cast<My_File_Browser*>(c)->Fl_File_Browser::incr_height();
+ return (static_cast<Fl_File_Browser*>(c)->*(&Friend_Browser::incr_height))();
+}
+
+
+
+
+int fl_file_browser_item_width(FILEBROWSER b, void * item) {
+ // return static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_width(item);
+ return (static_cast<Fl_File_Browser*>(b)->*(&Friend_Browser::item_width))(item);
+}
+
+int fl_file_browser_item_height(FILEBROWSER b, void * item) {
+ // return static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_height(item);
+ return (static_cast<Fl_File_Browser*>(b)->*(&Friend_Browser::item_height))(item);
+}
+
+void * fl_file_browser_item_first(FILEBROWSER b) {
+ return static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_first();
+}
+
+void * fl_file_browser_item_last(FILEBROWSER b) {
+ return static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_last();
+}
+
+void * fl_file_browser_item_next(FILEBROWSER b, void * item) {
+ return static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_next(item);
+}
+
+void * fl_file_browser_item_prev(FILEBROWSER b, void * item) {
+ return static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_prev(item);
+}
+
+void * fl_file_browser_item_at(FILEBROWSER b, int index) {
+ return static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_at(index);
+}
+
+void fl_file_browser_item_select(FILEBROWSER b, void * item, int val) {
+ static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_select(item, val);
+}
+
+int fl_file_browser_item_selected(FILEBROWSER b, void * item) {
+ return static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_selected(item);
+}
+
+void fl_file_browser_item_swap(FILEBROWSER b, void * x, void * y) {
+ static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_swap(x, y);
+}
+
+const char * fl_file_browser_item_text(FILEBROWSER b, void * item) {
+ return static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_text(item);
+}
+
+void fl_file_browser_item_draw(FILEBROWSER b, void * item, int x, int y, int w, int h) {
+ // static_cast<My_File_Browser*>(b)->Fl_File_Browser::item_draw(item, x, y, w, h);
+ (static_cast<Fl_File_Browser*>(b)->*(&Friend_Browser::item_draw))(item, x, y, w, h);
+}
+
+
+
+
+int fl_file_browser_full_width(FILEBROWSER c) {
+ return static_cast<My_File_Browser*>(c)->Fl_File_Browser::full_width();
+}
+
+int fl_file_browser_item_quick_height(FILEBROWSER c, void * i) {
+ return static_cast<My_File_Browser*>(c)->Fl_File_Browser::item_quick_height(i);
+}
+
+
+
+
+void fl_file_browser_draw(FILEBROWSER b) {
+ static_cast<My_File_Browser*>(b)->Fl_File_Browser::draw();
+}
+
+int fl_file_browser_handle(FILEBROWSER b, int e) {
+ return static_cast<My_File_Browser*>(b)->Fl_File_Browser::handle(e);
+}
+
+
diff --git a/body/c_fl_file_browser.h b/body/c_fl_file_browser.h
new file mode 100644
index 0000000..67e1489
--- /dev/null
+++ b/body/c_fl_file_browser.h
@@ -0,0 +1,61 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_FILE_BROWSER_GUARD
+#define FL_FILE_BROWSER_GUARD
+
+
+typedef void* FILEBROWSER;
+
+
+extern "C" FILEBROWSER new_fl_file_browser(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_file_browser(FILEBROWSER b);
+
+
+extern "C" int fl_file_browser_load(FILEBROWSER b, const char * d, void * s);
+
+
+extern "C" int fl_file_browser_get_filetype(FILEBROWSER b);
+extern "C" void fl_file_browser_set_filetype(FILEBROWSER b, int f);
+extern "C" const char * fl_file_browser_get_filter(FILEBROWSER b);
+extern "C" void fl_file_browser_set_filter(FILEBROWSER b, const char * f);
+extern "C" unsigned char fl_file_browser_get_iconsize(FILEBROWSER b);
+extern "C" void fl_file_browser_set_iconsize(FILEBROWSER b, unsigned int i);
+extern "C" int fl_file_browser_get_textsize(FILEBROWSER b);
+extern "C" void fl_file_browser_set_textsize(FILEBROWSER b, int s);
+
+
+// reimp below here
+
+extern "C" int fl_file_browser_full_height(FILEBROWSER c);
+extern "C" int fl_file_browser_incr_height(FILEBROWSER c);
+
+
+extern "C" int fl_file_browser_item_width(FILEBROWSER b, void * item);
+extern "C" int fl_file_browser_item_height(FILEBROWSER b, void * item);
+extern "C" void * fl_file_browser_item_first(FILEBROWSER b);
+extern "C" void * fl_file_browser_item_last(FILEBROWSER b);
+extern "C" void * fl_file_browser_item_next(FILEBROWSER b, void * item);
+extern "C" void * fl_file_browser_item_prev(FILEBROWSER b, void * item);
+extern "C" void * fl_file_browser_item_at(FILEBROWSER b, int index);
+extern "C" void fl_file_browser_item_select(FILEBROWSER b, void * item, int val=1);
+extern "C" int fl_file_browser_item_selected(FILEBROWSER b, void * item);
+extern "C" void fl_file_browser_item_swap(FILEBROWSER b, void * x, void * y);
+extern "C" const char * fl_file_browser_item_text(FILEBROWSER b, void * item);
+extern "C" void fl_file_browser_item_draw(FILEBROWSER b, void * item, int x, int y, int w, int h);
+
+
+extern "C" int fl_file_browser_full_width(FILEBROWSER c);
+extern "C" int fl_file_browser_item_quick_height(FILEBROWSER c, void * i);
+
+
+extern "C" void fl_file_browser_draw(FILEBROWSER b);
+extern "C" int fl_file_browser_handle(FILEBROWSER b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_file_chooser.cpp b/body/c_fl_file_chooser.cpp
new file mode 100644
index 0000000..bdb35b0
--- /dev/null
+++ b/body/c_fl_file_chooser.cpp
@@ -0,0 +1,340 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_File_Chooser.H>
+#include <FL/Fl_Widget.H>
+#include "c_fl_file_chooser.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" int file_chooser_sort_hook(const char * a, const char * b);
+
+
+
+
+// Some extra setup
+
+int file_chooser_sort_prehook(struct dirent ** a, struct dirent ** b) {
+ return file_chooser_sort_hook((*a)->d_name, (*b)->d_name);
+}
+
+void file_chooser_setup_sort_hook() {
+ Fl_File_Chooser::sort = &file_chooser_sort_prehook;
+}
+
+
+
+
+// Flattened C API begins here
+
+FILECHOOSER new_fl_file_chooser(const char * n, const char * p, int k, const char * t) {
+ Fl_File_Chooser *f = new Fl_File_Chooser(n, p, k, t);
+ return f;
+}
+
+void free_fl_file_chooser(FILECHOOSER f) {
+ delete static_cast<Fl_File_Chooser*>(f);
+}
+
+
+
+
+void * fl_file_chooser_get_user_data(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->user_data();
+}
+
+void fl_file_chooser_set_user_data(FILECHOOSER f, void * ud) {
+ static_cast<Fl_File_Chooser*>(f)->user_data(ud);
+}
+
+
+
+
+void * fl_file_chooser_newbutton(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->newButton;
+}
+
+void * fl_file_chooser_previewbutton(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->previewButton;
+}
+
+void * fl_file_chooser_showhiddenbutton(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->showHiddenButton;
+}
+
+
+
+
+const char * fl_file_chooser_get_add_favorites_label() {
+ return Fl_File_Chooser::add_favorites_label;
+}
+
+void fl_file_chooser_set_add_favorites_label(const char * s) {
+ Fl_File_Chooser::add_favorites_label = s;
+}
+
+const char * fl_file_chooser_get_all_files_label() {
+ return Fl_File_Chooser::all_files_label;
+}
+
+void fl_file_chooser_set_all_files_label(const char * s) {
+ Fl_File_Chooser::all_files_label = s;
+}
+
+const char * fl_file_chooser_get_custom_filter_label() {
+ return Fl_File_Chooser::custom_filter_label;
+}
+
+void fl_file_chooser_set_custom_filter_label(const char * s) {
+ Fl_File_Chooser::custom_filter_label = s;
+}
+
+const char * fl_file_chooser_get_existing_file_label() {
+ return Fl_File_Chooser::existing_file_label;
+}
+
+void fl_file_chooser_set_existing_file_label(const char * s) {
+ Fl_File_Chooser::existing_file_label = s;
+}
+
+const char * fl_file_chooser_get_favorites_label() {
+ return Fl_File_Chooser::favorites_label;
+}
+
+void fl_file_chooser_set_favorites_label(const char * s) {
+ Fl_File_Chooser::favorites_label = s;
+}
+
+const char * fl_file_chooser_get_filename_label() {
+ return Fl_File_Chooser::filename_label;
+}
+
+void fl_file_chooser_set_filename_label(const char * s) {
+ Fl_File_Chooser::filename_label = s;
+}
+
+const char * fl_file_chooser_get_filesystems_label() {
+ return Fl_File_Chooser::filesystems_label;
+}
+
+void fl_file_chooser_set_filesystems_label(const char * s) {
+ Fl_File_Chooser::filesystems_label = s;
+}
+
+const char * fl_file_chooser_get_hidden_label() {
+ return Fl_File_Chooser::hidden_label;
+}
+
+void fl_file_chooser_set_hidden_label(const char * s) {
+ Fl_File_Chooser::hidden_label = s;
+}
+
+const char * fl_file_chooser_get_manage_favorites_label() {
+ return Fl_File_Chooser::manage_favorites_label;
+}
+
+void fl_file_chooser_set_manage_favorites_label(const char * s) {
+ Fl_File_Chooser::manage_favorites_label = s;
+}
+
+const char * fl_file_chooser_get_new_directory_label() {
+ return Fl_File_Chooser::new_directory_label;
+}
+
+void fl_file_chooser_set_new_directory_label(const char * s) {
+ Fl_File_Chooser::new_directory_label = s;
+}
+
+const char * fl_file_chooser_get_new_directory_tooltip() {
+ return Fl_File_Chooser::new_directory_tooltip;
+}
+
+void fl_file_chooser_set_new_directory_tooltip(const char * s) {
+ Fl_File_Chooser::new_directory_tooltip = s;
+}
+
+const char * fl_file_chooser_get_preview_label() {
+ return Fl_File_Chooser::preview_label;
+}
+
+void fl_file_chooser_set_preview_label(const char * s) {
+ Fl_File_Chooser::preview_label = s;
+}
+
+const char * fl_file_chooser_get_save_label() {
+ return Fl_File_Chooser::save_label;
+}
+
+void fl_file_chooser_set_save_label(const char * s) {
+ Fl_File_Chooser::save_label = s;
+}
+
+const char * fl_file_chooser_get_show_label() {
+ return Fl_File_Chooser::show_label;
+}
+
+void fl_file_chooser_set_show_label(const char * s) {
+ Fl_File_Chooser::show_label = s;
+}
+
+
+
+
+void * fl_file_chooser_add_extra(FILECHOOSER f, void * w) {
+ return static_cast<Fl_File_Chooser*>(f)->add_extra(static_cast<Fl_Widget*>(w));
+}
+
+typedef void (*Chooser_Callback)(Fl_File_Chooser *, void *);
+
+void fl_file_chooser_callback(FILECHOOSER f, void * c, void * u) {
+ static_cast<Fl_File_Chooser*>(f)->callback(reinterpret_cast<Chooser_Callback>(c), u);
+}
+
+
+
+
+unsigned int fl_file_chooser_get_color(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->color();
+}
+
+void fl_file_chooser_set_color(FILECHOOSER f, unsigned int c) {
+ static_cast<Fl_File_Chooser*>(f)->color(c);
+}
+
+unsigned char fl_file_chooser_get_iconsize(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->iconsize();
+}
+
+void fl_file_chooser_set_iconsize(FILECHOOSER f, unsigned char i) {
+ static_cast<Fl_File_Chooser*>(f)->iconsize(i);
+}
+
+const char * fl_file_chooser_get_label(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->label();
+}
+
+void fl_file_chooser_set_label(FILECHOOSER f, const char * t) {
+ static_cast<Fl_File_Chooser*>(f)->label(t);
+}
+
+const char * fl_file_chooser_get_ok_label(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->ok_label();
+}
+
+void fl_file_chooser_set_ok_label(FILECHOOSER f, const char * t) {
+ static_cast<Fl_File_Chooser*>(f)->ok_label(t);
+}
+
+int fl_file_chooser_get_preview(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->preview();
+}
+
+void fl_file_chooser_set_preview(FILECHOOSER f, int p) {
+ static_cast<Fl_File_Chooser*>(f)->preview(p);
+}
+
+unsigned int fl_file_chooser_get_textcolor(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->textcolor();
+}
+
+void fl_file_chooser_set_textcolor(FILECHOOSER f, unsigned int c) {
+ static_cast<Fl_File_Chooser*>(f)->textcolor(c);
+}
+
+int fl_file_chooser_get_textfont(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->textfont();
+}
+
+void fl_file_chooser_set_textfont(FILECHOOSER f, int n) {
+ static_cast<Fl_File_Chooser*>(f)->textfont(n);
+}
+
+int fl_file_chooser_get_textsize(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->textsize();
+}
+
+void fl_file_chooser_set_textsize(FILECHOOSER f, int s) {
+ static_cast<Fl_File_Chooser*>(f)->textsize(s);
+}
+
+int fl_file_chooser_get_type(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->type();
+}
+
+void fl_file_chooser_set_type(FILECHOOSER f, int t) {
+ static_cast<Fl_File_Chooser*>(f)->type(t);
+}
+
+
+
+
+int fl_file_chooser_count(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->count();
+}
+
+const char * fl_file_chooser_get_directory(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->directory();
+}
+
+void fl_file_chooser_set_directory(FILECHOOSER f, const char * v) {
+ static_cast<Fl_File_Chooser*>(f)->directory(v);
+}
+
+const char * fl_file_chooser_get_filter(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->filter();
+}
+
+void fl_file_chooser_set_filter(FILECHOOSER f, const char * v) {
+ static_cast<Fl_File_Chooser*>(f)->filter(v);
+}
+
+int fl_file_chooser_get_filter_value(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->filter_value();
+}
+
+void fl_file_chooser_set_filter_value(FILECHOOSER f, int v) {
+ static_cast<Fl_File_Chooser*>(f)->filter_value(v);
+}
+
+void fl_file_chooser_rescan(FILECHOOSER f) {
+ static_cast<Fl_File_Chooser*>(f)->rescan();
+}
+
+void fl_file_chooser_rescan_keep_filename(FILECHOOSER f) {
+ static_cast<Fl_File_Chooser*>(f)->rescan_keep_filename();
+}
+
+const char * fl_file_chooser_get_value(FILECHOOSER f, int n) {
+ return static_cast<Fl_File_Chooser*>(f)->value(n);
+}
+
+void fl_file_chooser_set_value(FILECHOOSER f, const char * v) {
+ static_cast<Fl_File_Chooser*>(f)->value(v);
+}
+
+
+
+
+void fl_file_chooser_show(FILECHOOSER f) {
+ static_cast<Fl_File_Chooser*>(f)->show();
+}
+
+void fl_file_chooser_hide(FILECHOOSER f) {
+ static_cast<Fl_File_Chooser*>(f)->hide();
+}
+
+int fl_file_chooser_shown(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->shown();
+}
+
+int fl_file_chooser_visible(FILECHOOSER f) {
+ return static_cast<Fl_File_Chooser*>(f)->visible();
+}
+
+
diff --git a/body/c_fl_file_chooser.h b/body/c_fl_file_chooser.h
new file mode 100644
index 0000000..17ee63c
--- /dev/null
+++ b/body/c_fl_file_chooser.h
@@ -0,0 +1,105 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_FILE_CHOOSER_GUARD
+#define FL_FILE_CHOOSER_GUARD
+
+
+typedef void* FILECHOOSER;
+
+
+extern "C" void file_chooser_setup_sort_hook();
+
+
+extern "C" FILECHOOSER new_fl_file_chooser(const char * n, const char * p, int k, const char * t);
+extern "C" void free_fl_file_chooser(FILECHOOSER f);
+
+
+extern "C" void * fl_file_chooser_get_user_data(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_user_data(FILECHOOSER f, void * ud);
+
+
+extern "C" void * fl_file_chooser_newbutton(FILECHOOSER f);
+extern "C" void * fl_file_chooser_previewbutton(FILECHOOSER f);
+extern "C" void * fl_file_chooser_showhiddenbutton(FILECHOOSER f);
+
+
+extern "C" const char * fl_file_chooser_get_add_favorites_label();
+extern "C" void fl_file_chooser_set_add_favorites_label(const char * s);
+extern "C" const char * fl_file_chooser_get_all_files_label();
+extern "C" void fl_file_chooser_set_all_files_label(const char * s);
+extern "C" const char * fl_file_chooser_get_custom_filter_label();
+extern "C" void fl_file_chooser_set_custom_filter_label(const char * s);
+extern "C" const char * fl_file_chooser_get_existing_file_label();
+extern "C" void fl_file_chooser_set_existing_file_label(const char * s);
+extern "C" const char * fl_file_chooser_get_favorites_label();
+extern "C" void fl_file_chooser_set_favorites_label(const char * s);
+extern "C" const char * fl_file_chooser_get_filename_label();
+extern "C" void fl_file_chooser_set_filename_label(const char * s);
+extern "C" const char * fl_file_chooser_get_filesystems_label();
+extern "C" void fl_file_chooser_set_filesystems_label(const char * s);
+extern "C" const char * fl_file_chooser_get_hidden_label();
+extern "C" void fl_file_chooser_set_hidden_label(const char * s);
+extern "C" const char * fl_file_chooser_get_manage_favorites_label();
+extern "C" void fl_file_chooser_set_manage_favorites_label(const char * s);
+extern "C" const char * fl_file_chooser_get_new_directory_label();
+extern "C" void fl_file_chooser_set_new_directory_label(const char * s);
+extern "C" const char * fl_file_chooser_get_new_directory_tooltip();
+extern "C" void fl_file_chooser_set_new_directory_tooltip(const char * s);
+extern "C" const char * fl_file_chooser_get_preview_label();
+extern "C" void fl_file_chooser_set_preview_label(const char * s);
+extern "C" const char * fl_file_chooser_get_save_label();
+extern "C" void fl_file_chooser_set_save_label(const char * s);
+extern "C" const char * fl_file_chooser_get_show_label();
+extern "C" void fl_file_chooser_set_show_label(const char * s);
+
+
+extern "C" void * fl_file_chooser_add_extra(FILECHOOSER f, void * w);
+extern "C" void fl_file_chooser_callback(FILECHOOSER f, void * c, void * u);
+
+
+extern "C" unsigned int fl_file_chooser_get_color(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_color(FILECHOOSER f, unsigned int c);
+extern "C" unsigned char fl_file_chooser_get_iconsize(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_iconsize(FILECHOOSER f, unsigned char i);
+extern "C" const char * fl_file_chooser_get_label(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_label(FILECHOOSER f, const char * t);
+extern "C" const char * fl_file_chooser_get_ok_label(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_ok_label(FILECHOOSER f, const char * t);
+extern "C" int fl_file_chooser_get_preview(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_preview(FILECHOOSER f, int p);
+extern "C" unsigned int fl_file_chooser_get_textcolor(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_textcolor(FILECHOOSER f, unsigned int c);
+extern "C" int fl_file_chooser_get_textfont(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_textfont(FILECHOOSER f, int n);
+extern "C" int fl_file_chooser_get_textsize(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_textsize(FILECHOOSER f, int s);
+extern "C" int fl_file_chooser_get_type(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_type(FILECHOOSER f, int t);
+
+
+extern "C" int fl_file_chooser_count(FILECHOOSER f);
+extern "C" const char * fl_file_chooser_get_directory(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_directory(FILECHOOSER f, const char * v);
+extern "C" const char * fl_file_chooser_get_filter(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_filter(FILECHOOSER f, const char * v);
+extern "C" int fl_file_chooser_get_filter_value(FILECHOOSER f);
+extern "C" void fl_file_chooser_set_filter_value(FILECHOOSER f, int v);
+extern "C" void fl_file_chooser_rescan(FILECHOOSER f);
+extern "C" void fl_file_chooser_rescan_keep_filename(FILECHOOSER f);
+extern "C" const char * fl_file_chooser_get_value(FILECHOOSER f, int n);
+extern "C" void fl_file_chooser_set_value(FILECHOOSER f, const char * v);
+
+
+extern "C" void fl_file_chooser_show(FILECHOOSER f);
+extern "C" void fl_file_chooser_hide(FILECHOOSER f);
+extern "C" int fl_file_chooser_shown(FILECHOOSER f);
+extern "C" int fl_file_chooser_visible(FILECHOOSER f);
+
+
+#endif
+
+
diff --git a/body/c_fl_file_input.cpp b/body/c_fl_file_input.cpp
new file mode 100644
index 0000000..8d0b15f
--- /dev/null
+++ b/body/c_fl_file_input.cpp
@@ -0,0 +1,97 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_File_Input.H>
+#include "c_fl_file_input.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_File_Input : public Fl_File_Input {
+public:
+ using Fl_File_Input::Fl_File_Input;
+
+ friend void fl_file_input_draw(FILEINPUT i);
+ friend int fl_file_input_handle(FILEINPUT i, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_File_Input::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_File_Input::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+FILEINPUT new_fl_file_input(int x, int y, int w, int h, char* label) {
+ My_File_Input *i = new My_File_Input(x, y, w, h, label);
+ return i;
+}
+
+void free_fl_file_input(FILEINPUT i) {
+ delete static_cast<My_File_Input*>(i);
+}
+
+
+
+
+int fl_file_input_get_down_box(FILEINPUT i) {
+ return static_cast<Fl_File_Input*>(i)->down_box();
+}
+
+void fl_file_input_set_down_box(FILEINPUT i, int t) {
+ static_cast<Fl_File_Input*>(i)->down_box(static_cast<Fl_Boxtype>(t));
+}
+
+unsigned int fl_file_input_get_errorcolor(FILEINPUT i) {
+ return static_cast<Fl_File_Input*>(i)->errorcolor();
+}
+
+void fl_file_input_set_errorcolor(FILEINPUT i, unsigned int t) {
+ static_cast<Fl_File_Input*>(i)->errorcolor(t);
+}
+
+
+
+
+const char * fl_file_input_get_value(FILEINPUT i) {
+ return static_cast<Fl_File_Input*>(i)->value();
+}
+
+int fl_file_input_set_value(FILEINPUT i, const char * s, int len) {
+ return static_cast<Fl_File_Input*>(i)->value(s,len);
+}
+
+
+
+
+void fl_file_input_draw(FILEINPUT i) {
+ static_cast<My_File_Input*>(i)->Fl_File_Input::draw();
+}
+
+int fl_file_input_handle(FILEINPUT i, int e) {
+ return static_cast<My_File_Input*>(i)->Fl_File_Input::handle(e);
+}
+
+
diff --git a/body/c_fl_file_input.h b/body/c_fl_file_input.h
new file mode 100644
index 0000000..df05cbb
--- /dev/null
+++ b/body/c_fl_file_input.h
@@ -0,0 +1,34 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_FILE_INPUT_GUARD
+#define FL_FILE_INPUT_GUARD
+
+
+typedef void* FILEINPUT;
+
+
+extern "C" FILEINPUT new_fl_file_input(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_file_input(FILEINPUT i);
+
+
+extern "C" int fl_file_input_get_down_box(FILEINPUT i);
+extern "C" void fl_file_input_set_down_box(FILEINPUT i, int t);
+extern "C" unsigned int fl_file_input_get_errorcolor(FILEINPUT i);
+extern "C" void fl_file_input_set_errorcolor(FILEINPUT i, unsigned int t);
+
+
+extern "C" const char * fl_file_input_get_value(FILEINPUT i);
+extern "C" int fl_file_input_set_value(FILEINPUT i, const char * s, int len);
+
+
+extern "C" void fl_file_input_draw(FILEINPUT i);
+extern "C" int fl_file_input_handle(FILEINPUT i, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_filename.cpp b/body/c_fl_filename.cpp
new file mode 100644
index 0000000..300f4ff
--- /dev/null
+++ b/body/c_fl_filename.cpp
@@ -0,0 +1,127 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/filename.H>
+#include <string.h>
+#include "c_fl_filename.h"
+
+
+
+
+const int fl_path_max = FL_PATH_MAX;
+
+
+
+
+void free_filename_file_list(void * l, int n) {
+ struct dirent ** p = static_cast<struct dirent **>(l);
+ fl_filename_free_list(&p, n);
+}
+
+const char * filename_dname(void * l, int n) {
+ return (static_cast<struct dirent **>(l)[n])->d_name;
+}
+
+
+
+
+void filename_decode_uri(char *uri) {
+ fl_decode_uri(uri);
+}
+
+int filename_absolute(char * to, int tolen, const char * from) {
+ return fl_filename_absolute(to, tolen, from);
+}
+
+int filename_expand(char * to, int tolen, const char * from) {
+ return fl_filename_expand(to, tolen, from);
+}
+
+const char * filename_ext(const char * buf) {
+ return fl_filename_ext(buf);
+}
+
+int filename_isdir(const char * name) {
+ return fl_filename_isdir(name);
+}
+
+int filename_list(const char * d, void * l, void * f) {
+ return fl_filename_list(d, static_cast<struct dirent ***>(l),
+ reinterpret_cast<Fl_File_Sort_F*>(f));
+}
+
+int filename_match(const char * name, const char * pattern) {
+ return fl_filename_match(name, pattern);
+}
+
+const char * filename_name(const char * name) {
+ return fl_filename_name(name);
+}
+
+int filename_relative(char * to, int tolen, const char * from) {
+ return fl_filename_relative(to, tolen, from);
+}
+
+char * filename_setext(char * to, int tolen, const char * ext) {
+ return fl_filename_setext(to, tolen, ext);
+}
+
+int filename_open_uri(const char * uri, char * msg, int msglen) {
+ return fl_open_uri(uri, msg, msglen);
+}
+
+
+
+
+int filename_alphasort(char * a, char * b) {
+ struct dirent d_aye, d_bee;
+ d_aye.d_name[0] = '\0';
+ strncat (d_aye.d_name, a, 255);
+ d_bee.d_name[0] = '\0';
+ strncat (d_bee.d_name, b, 255);
+ struct dirent * dp_aye = &d_aye;
+ struct dirent * dp_bee = &d_bee;
+ int result = fl_alphasort(&dp_aye, &dp_bee);
+ return result < 0 ? 0 : result == 0 ? 1 : 2;
+}
+
+int filename_casealphasort(char * a, char * b) {
+ struct dirent d_aye, d_bee;
+ d_aye.d_name[0] = '\0';
+ strncat (d_aye.d_name, a, 255);
+ d_bee.d_name[0] = '\0';
+ strncat (d_bee.d_name, b, 255);
+ struct dirent * dp_aye = &d_aye;
+ struct dirent * dp_bee = &d_bee;
+ int result = fl_casealphasort(&dp_aye, &dp_bee);
+ return result < 0 ? 0 : result == 0 ? 1 : 2;
+}
+
+int filename_numericsort(char * a, char * b) {
+ struct dirent d_aye, d_bee;
+ d_aye.d_name[0] = '\0';
+ strncat (d_aye.d_name, a, 255);
+ d_bee.d_name[0] = '\0';
+ strncat (d_bee.d_name, b, 255);
+ struct dirent * dp_aye = &d_aye;
+ struct dirent * dp_bee = &d_bee;
+ int result = fl_numericsort(&dp_aye, &dp_bee);
+ return result < 0 ? 0 : result == 0 ? 1 : 2;
+}
+
+int filename_casenumericsort(char * a, char * b) {
+ struct dirent d_aye, d_bee;
+ d_aye.d_name[0] = '\0';
+ strncat (d_aye.d_name, a, 255);
+ d_bee.d_name[0] = '\0';
+ strncat (d_bee.d_name, b, 255);
+ struct dirent * dp_aye = &d_aye;
+ struct dirent * dp_bee = &d_bee;
+ int result = fl_casenumericsort(&dp_aye, &dp_bee);
+ return result < 0 ? 0 : result == 0 ? 1 : 2;
+}
+
+
diff --git a/body/c_fl_filename.h b/body/c_fl_filename.h
new file mode 100644
index 0000000..0839293
--- /dev/null
+++ b/body/c_fl_filename.h
@@ -0,0 +1,39 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_FILENAME_GUARD
+#define FL_FILENAME_GUARD
+
+
+extern "C" const int fl_path_max;
+
+
+extern "C" void free_filename_file_list(void * l, int n);
+extern "C" const char * filename_dname(void * l, int n);
+
+
+extern "C" void filename_decode_uri(char *uri);
+extern "C" int filename_absolute(char * to, int tolen, const char * from);
+extern "C" int filename_expand(char * to, int tolen, const char * from);
+extern "C" const char * filename_ext(const char * buf);
+extern "C" int filename_isdir(const char * name);
+extern "C" int filename_list(const char * d, void * l, void * f);
+extern "C" int filename_match(const char * name, const char * pattern);
+extern "C" const char * filename_name(const char * name);
+extern "C" int filename_relative(char * to, int tolen, const char * from);
+extern "C" char * filename_setext(char * to, int tolen, const char * ext);
+extern "C" int filename_open_uri(const char * uri, char * msg, int msglen);
+
+
+extern "C" int filename_alphasort(char * a, char * b);
+extern "C" int filename_casealphasort(char * a, char * b);
+extern "C" int filename_numericsort(char * a, char * b);
+extern "C" int filename_casenumericsort(char * a, char * b);
+
+
+#endif
+
+
diff --git a/body/c_fl_fill_dial.cpp b/body/c_fl_fill_dial.cpp
new file mode 100644
index 0000000..47833c1
--- /dev/null
+++ b/body/c_fl_fill_dial.cpp
@@ -0,0 +1,74 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Fill_Dial.H>
+#include "c_fl_fill_dial.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Fill_Dial : public Fl_Fill_Dial {
+public:
+ using Fl_Fill_Dial::Fl_Fill_Dial;
+
+ friend void fl_fill_dial_draw(FILLDIAL v);
+ friend int fl_fill_dial_handle(FILLDIAL v, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Fill_Dial::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Fill_Dial::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Fill_Dial::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+FILLDIAL new_fl_fill_dial(int x, int y, int w, int h, char* label) {
+ My_Fill_Dial *v = new My_Fill_Dial(x, y, w, h, label);
+ return v;
+}
+
+void free_fl_fill_dial(FILLDIAL v) {
+ delete static_cast<My_Fill_Dial*>(v);
+}
+
+
+
+
+void fl_fill_dial_draw(FILLDIAL v) {
+ static_cast<My_Fill_Dial*>(v)->Fl_Fill_Dial::draw();
+}
+
+int fl_fill_dial_handle(FILLDIAL v, int e) {
+ return static_cast<My_Fill_Dial*>(v)->Fl_Fill_Dial::handle(e);
+}
+
+
diff --git a/body/c_fl_fill_dial.h b/body/c_fl_fill_dial.h
new file mode 100644
index 0000000..00a8094
--- /dev/null
+++ b/body/c_fl_fill_dial.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_FILL_DIAL_GUARD
+#define FL_FILL_DIAL_GUARD
+
+
+typedef void* FILLDIAL;
+
+
+extern "C" FILLDIAL new_fl_fill_dial(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_fill_dial(FILLDIAL v);
+
+
+extern "C" void fl_fill_dial_draw(FILLDIAL v);
+extern "C" int fl_fill_dial_handle(FILLDIAL v, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_fill_slider.cpp b/body/c_fl_fill_slider.cpp
new file mode 100644
index 0000000..49834d4
--- /dev/null
+++ b/body/c_fl_fill_slider.cpp
@@ -0,0 +1,74 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Fill_Slider.H>
+#include "c_fl_fill_slider.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Fill_Slider : public Fl_Fill_Slider {
+public:
+ using Fl_Fill_Slider::Fl_Fill_Slider;
+
+ friend void fl_fill_slider_draw(FILLSLIDER s);
+ friend int fl_fill_slider_handle(FILLSLIDER s, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Fill_Slider::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Fill_Slider::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Fill_Slider::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+FILLSLIDER new_fl_fill_slider(int x, int y, int w, int h, char* label) {
+ My_Fill_Slider *s = new My_Fill_Slider(x, y, w, h, label);
+ return s;
+}
+
+void free_fl_fill_slider(FILLSLIDER s) {
+ delete static_cast<My_Fill_Slider*>(s);
+}
+
+
+
+
+void fl_fill_slider_draw(FILLSLIDER s) {
+ static_cast<My_Fill_Slider*>(s)->Fl_Fill_Slider::draw();
+}
+
+int fl_fill_slider_handle(FILLSLIDER s, int e) {
+ return static_cast<My_Fill_Slider*>(s)->Fl_Fill_Slider::handle(e);
+}
+
+
diff --git a/body/c_fl_fill_slider.h b/body/c_fl_fill_slider.h
new file mode 100644
index 0000000..d208d93
--- /dev/null
+++ b/body/c_fl_fill_slider.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_FILL_SLIDER_GUARD
+#define FL_FILL_SLIDER_GUARD
+
+
+typedef void* FILLSLIDER;
+
+
+extern "C" FILLSLIDER new_fl_fill_slider(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_fill_slider(FILLSLIDER s);
+
+
+extern "C" void fl_fill_slider_draw(FILLSLIDER s);
+extern "C" int fl_fill_slider_handle(FILLSLIDER s, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_float_input.cpp b/body/c_fl_float_input.cpp
new file mode 100644
index 0000000..eedfa36
--- /dev/null
+++ b/body/c_fl_float_input.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Float_Input.H>
+#include "c_fl_float_input.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Float_Input : public Fl_Float_Input {
+public:
+ using Fl_Float_Input::Fl_Float_Input;
+
+ friend void fl_float_input_draw(FLOATINPUT i);
+ friend int fl_float_input_handle(FLOATINPUT i, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Float_Input::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Float_Input::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+FLOATINPUT new_fl_float_input(int x, int y, int w, int h, char* label) {
+ My_Float_Input *i = new My_Float_Input(x, y, w, h, label);
+ return i;
+}
+
+void free_fl_float_input(FLOATINPUT i) {
+ delete static_cast<My_Float_Input*>(i);
+}
+
+
+
+
+void fl_float_input_draw(FLOATINPUT i) {
+ static_cast<My_Float_Input*>(i)->Fl_Float_Input::draw();
+}
+
+int fl_float_input_handle(FLOATINPUT i, int e) {
+ return static_cast<My_Float_Input*>(i)->Fl_Float_Input::handle(e);
+}
+
+
diff --git a/body/c_fl_float_input.h b/body/c_fl_float_input.h
new file mode 100644
index 0000000..5ee1689
--- /dev/null
+++ b/body/c_fl_float_input.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_FLOAT_INPUT_GUARD
+#define FL_FLOAT_INPUT_GUARD
+
+
+typedef void* FLOATINPUT;
+
+
+extern "C" FLOATINPUT new_fl_float_input(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_float_input(FLOATINPUT i);
+
+
+extern "C" void fl_float_input_draw(FLOATINPUT i);
+extern "C" int fl_float_input_handle(FLOATINPUT i, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_gif_image.cpp b/body/c_fl_gif_image.cpp
new file mode 100644
index 0000000..9ab5519
--- /dev/null
+++ b/body/c_fl_gif_image.cpp
@@ -0,0 +1,22 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_GIF_Image.H>
+#include "c_fl_gif_image.h"
+
+
+
+
+GIFIMAGE new_fl_gif_image(const char * f) {
+ Fl_GIF_Image *j = new Fl_GIF_Image(f);
+ return j;
+}
+
+void free_fl_gif_image(GIFIMAGE j) {
+ delete static_cast<Fl_GIF_Image*>(j);
+}
+
+
diff --git a/body/c_fl_gif_image.h b/body/c_fl_gif_image.h
new file mode 100644
index 0000000..4d340cd
--- /dev/null
+++ b/body/c_fl_gif_image.h
@@ -0,0 +1,20 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_GIF_IMAGE_GUARD
+#define FL_GIF_IMAGE_GUARD
+
+
+typedef void* GIFIMAGE;
+
+
+extern "C" GIFIMAGE new_fl_gif_image(const char * f);
+extern "C" void free_fl_gif_image(GIFIMAGE j);
+
+
+#endif
+
+
diff --git a/body/c_fl_gl_window.cpp b/body/c_fl_gl_window.cpp
new file mode 100644
index 0000000..3d6cbd5
--- /dev/null
+++ b/body/c_fl_gl_window.cpp
@@ -0,0 +1,191 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Gl_Window.H>
+#include "c_fl_gl_window.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Gl_Window : public Fl_Gl_Window {
+public:
+ using Fl_Gl_Window::Fl_Gl_Window;
+
+ friend void fl_gl_window_draw(GLWINDOW n);
+ friend int fl_gl_window_handle(GLWINDOW n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Gl_Window::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Gl_Window::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+GLWINDOW new_fl_gl_window(int x, int y, int w, int h, char* label) {
+ My_Gl_Window *gw = new My_Gl_Window(x, y, w, h, label);
+ return gw;
+}
+
+GLWINDOW new_fl_gl_window2(int w, int h, char* label) {
+ My_Gl_Window *gw = new My_Gl_Window(w, h, label);
+ return gw;
+}
+
+void free_fl_gl_window(GLWINDOW w) {
+ delete static_cast<My_Gl_Window*>(w);
+}
+
+
+
+
+void fl_gl_window_show(GLWINDOW w) {
+ static_cast<Fl_Gl_Window*>(w)->show();
+}
+
+void fl_gl_window_show2(GLWINDOW w, int c, void * v) {
+ static_cast<Fl_Gl_Window*>(w)->show(c, static_cast<char**>(v));
+}
+
+void fl_gl_window_hide(GLWINDOW w) {
+ static_cast<Fl_Gl_Window*>(w)->hide();
+}
+
+void fl_gl_window_hide_overlay(GLWINDOW w) {
+ static_cast<Fl_Gl_Window*>(w)->hide_overlay();
+}
+
+void fl_gl_window_flush(GLWINDOW w) {
+ static_cast<Fl_Gl_Window*>(w)->flush();
+}
+
+
+
+
+int fl_gl_window_pixel_h(GLWINDOW w) {
+ return static_cast<Fl_Gl_Window*>(w)->pixel_h();
+}
+
+int fl_gl_window_pixel_w(GLWINDOW w) {
+ return static_cast<Fl_Gl_Window*>(w)->pixel_w();
+}
+
+float fl_gl_window_pixels_per_unit(GLWINDOW w) {
+ return static_cast<Fl_Gl_Window*>(w)->pixels_per_unit();
+}
+
+void fl_gl_window_resize(GLWINDOW gw, int x, int y, int w, int h) {
+ static_cast<Fl_Gl_Window*>(gw)->resize(x, y, w, h);
+}
+
+
+
+
+unsigned int fl_gl_window_get_mode(GLWINDOW w) {
+ return static_cast<Fl_Gl_Window*>(w)->mode();
+}
+
+void fl_gl_window_set_mode(GLWINDOW w, unsigned int a) {
+ static_cast<Fl_Gl_Window*>(w)->mode(a);
+}
+
+int fl_gl_window_static_can_do(unsigned int m) {
+ return Fl_Gl_Window::can_do(m);
+}
+
+int fl_gl_window_can_do(GLWINDOW w) {
+ return static_cast<Fl_Gl_Window*>(w)->can_do();
+}
+
+int fl_gl_window_can_do_overlay(GLWINDOW w) {
+ return static_cast<Fl_Gl_Window*>(w)->can_do_overlay();
+}
+
+
+
+
+void * fl_gl_window_get_context(GLWINDOW w) {
+ return static_cast<Fl_Gl_Window*>(w)->context();
+}
+
+void fl_gl_window_set_context(GLWINDOW w, void * con, int des) {
+ static_cast<Fl_Gl_Window*>(w)->context(con, des);
+}
+
+char fl_gl_window_context_valid(GLWINDOW w) {
+ return static_cast<Fl_Gl_Window*>(w)->context_valid();
+}
+
+void fl_gl_window_set_context_valid(GLWINDOW w, char v) {
+ static_cast<Fl_Gl_Window*>(w)->context_valid(v);
+}
+
+char fl_gl_window_valid(GLWINDOW w) {
+ return static_cast<Fl_Gl_Window*>(w)->valid();
+}
+
+void fl_gl_window_set_valid(GLWINDOW w, char v) {
+ static_cast<Fl_Gl_Window*>(w)->valid(v);
+}
+
+void fl_gl_window_invalidate(GLWINDOW w) {
+ static_cast<Fl_Gl_Window*>(w)->invalidate();
+}
+
+void fl_gl_window_make_current(GLWINDOW w) {
+ static_cast<Fl_Gl_Window*>(w)->make_current();
+}
+
+void fl_gl_window_make_overlay_current(GLWINDOW w) {
+ static_cast<Fl_Gl_Window*>(w)->make_overlay_current();
+}
+
+
+
+
+void fl_gl_window_ortho(GLWINDOW w) {
+ static_cast<Fl_Gl_Window*>(w)->ortho();
+}
+
+void fl_gl_window_redraw_overlay(GLWINDOW w) {
+ static_cast<Fl_Gl_Window*>(w)->redraw_overlay();
+}
+
+void fl_gl_window_swap_buffers(GLWINDOW w) {
+ static_cast<Fl_Gl_Window*>(w)->swap_buffers();
+}
+
+
+
+
+void fl_gl_window_draw(GLWINDOW n) {
+ static_cast<My_Gl_Window*>(n)->Fl_Gl_Window::draw();
+}
+
+int fl_gl_window_handle(GLWINDOW n, int e) {
+ return static_cast<My_Gl_Window*>(n)->Fl_Gl_Window::handle(e);
+}
+
+
diff --git a/body/c_fl_gl_window.h b/body/c_fl_gl_window.h
new file mode 100644
index 0000000..6177db6
--- /dev/null
+++ b/body/c_fl_gl_window.h
@@ -0,0 +1,61 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_GL_WINDOW_GUARD
+#define FL_GL_WINDOW_GUARD
+
+
+typedef void* GLWINDOW;
+
+
+extern "C" GLWINDOW new_fl_gl_window(int x, int y, int w, int h, char* label);
+extern "C" GLWINDOW new_fl_gl_window2(int w, int h, char* label);
+extern "C" void free_fl_gl_window(GLWINDOW w);
+
+
+extern "C" void fl_gl_window_show(GLWINDOW w);
+extern "C" void fl_gl_window_show2(GLWINDOW w, int c, void * v);
+extern "C" void fl_gl_window_hide(GLWINDOW w);
+extern "C" void fl_gl_window_hide_overlay(GLWINDOW w);
+extern "C" void fl_gl_window_flush(GLWINDOW w);
+
+
+extern "C" int fl_gl_window_pixel_h(GLWINDOW w);
+extern "C" int fl_gl_window_pixel_w(GLWINDOW w);
+extern "C" float fl_gl_window_pixels_per_unit(GLWINDOW w);
+extern "C" void fl_gl_window_resize(GLWINDOW gw, int x, int y, int w, int h);
+
+
+extern "C" unsigned int fl_gl_window_get_mode(GLWINDOW w);
+extern "C" void fl_gl_window_set_mode(GLWINDOW w, unsigned int a);
+extern "C" int fl_gl_window_static_can_do(unsigned int m);
+extern "C" int fl_gl_window_can_do(GLWINDOW w);
+extern "C" int fl_gl_window_can_do_overlay(GLWINDOW w);
+
+
+extern "C" void * fl_gl_window_get_context(GLWINDOW w);
+extern "C" void fl_gl_window_set_context(GLWINDOW w, void * con, int des);
+extern "C" char fl_gl_window_context_valid(GLWINDOW w);
+extern "C" void fl_gl_window_set_context_valid(GLWINDOW w, char v);
+extern "C" char fl_gl_window_valid(GLWINDOW w);
+extern "C" void fl_gl_window_set_valid(GLWINDOW w, char v);
+extern "C" void fl_gl_window_invalidate(GLWINDOW w);
+extern "C" void fl_gl_window_make_current(GLWINDOW w);
+extern "C" void fl_gl_window_make_overlay_current(GLWINDOW w);
+
+
+extern "C" void fl_gl_window_ortho(GLWINDOW w);
+extern "C" void fl_gl_window_redraw_overlay(GLWINDOW w);
+extern "C" void fl_gl_window_swap_buffers(GLWINDOW w);
+
+
+extern "C" void fl_gl_window_draw(GLWINDOW n);
+extern "C" int fl_gl_window_handle(GLWINDOW n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_graphics_driver.cpp b/body/c_fl_graphics_driver.cpp
new file mode 100644
index 0000000..56bcf62
--- /dev/null
+++ b/body/c_fl_graphics_driver.cpp
@@ -0,0 +1,63 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Device.H>
+#include <FL/Fl_Image.H>
+#include "c_fl_graphics_driver.h"
+
+
+
+
+unsigned int fl_graphics_driver_color(GRAPHICSDRIVER g) {
+ return static_cast<Fl_Graphics_Driver*>(g)->color();
+}
+
+
+
+
+int fl_graphics_driver_descent(GRAPHICSDRIVER g) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::descent();
+}
+
+int fl_graphics_driver_height(GRAPHICSDRIVER g) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::height();
+}
+
+double fl_graphics_driver_width(GRAPHICSDRIVER g, unsigned int c) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::width(c);
+}
+
+double fl_graphics_driver_width2(GRAPHICSDRIVER g, const char * s, int l) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::width(s,l);
+}
+
+int fl_graphics_driver_get_font(GRAPHICSDRIVER g) {
+ return static_cast<Fl_Graphics_Driver*>(g)->font();
+}
+
+int fl_graphics_driver_size(GRAPHICSDRIVER g) {
+ return static_cast<Fl_Graphics_Driver*>(g)->size();
+}
+
+void fl_graphics_driver_set_font(GRAPHICSDRIVER g, int f, int s) {
+ // virtual so disable dispatch
+ static_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::font(f,s);
+}
+
+
+
+
+void fl_graphics_driver_draw_scaled(GRAPHICSDRIVER g, void * i, int x, int y, int w, int h) {
+ // virtual so disable dispatch
+ static_cast<Fl_Graphics_Driver*>(g)->Fl_Graphics_Driver::draw_scaled
+ (static_cast<Fl_Image*>(i),x,y,w,h);
+}
+
+
diff --git a/body/c_fl_graphics_driver.h b/body/c_fl_graphics_driver.h
new file mode 100644
index 0000000..e070235
--- /dev/null
+++ b/body/c_fl_graphics_driver.h
@@ -0,0 +1,32 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_GRAPHICS_DRIVER_GUARD
+#define FL_GRAPHICS_DRIVER_GUARD
+
+
+typedef void* GRAPHICSDRIVER;
+
+
+extern "C" unsigned int fl_graphics_driver_color(GRAPHICSDRIVER g);
+
+
+extern "C" int fl_graphics_driver_descent(GRAPHICSDRIVER g);
+extern "C" int fl_graphics_driver_height(GRAPHICSDRIVER g);
+extern "C" double fl_graphics_driver_width(GRAPHICSDRIVER g, unsigned int c);
+extern "C" double fl_graphics_driver_width2(GRAPHICSDRIVER g, const char * s, int l);
+extern "C" int fl_graphics_driver_get_font(GRAPHICSDRIVER g);
+extern "C" int fl_graphics_driver_size(GRAPHICSDRIVER g);
+extern "C" void fl_graphics_driver_set_font(GRAPHICSDRIVER g, int f, int s);
+
+
+extern "C" void fl_graphics_driver_draw_scaled(GRAPHICSDRIVER g, void * i,
+ int x, int y, int w, int h);
+
+
+#endif
+
+
diff --git a/body/c_fl_group.cpp b/body/c_fl_group.cpp
new file mode 100644
index 0000000..62bee03
--- /dev/null
+++ b/body/c_fl_group.cpp
@@ -0,0 +1,193 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Group.H>
+#include <FL/Fl_Widget.H>
+#include "c_fl_group.h"
+#include "c_fl_widget.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Group : Fl_Group {
+public:
+ using Fl_Group::draw_child;
+ using Fl_Group::draw_children;
+ using Fl_Group::draw_outside_label;
+ using Fl_Group::update_child;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Group : public Fl_Group {
+public:
+ using Fl_Group::Fl_Group;
+
+ friend void fl_group_draw(GROUP g);
+ friend int fl_group_handle(GROUP g, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Group::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Group::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+GROUP new_fl_group(int x, int y, int w, int h, char* label) {
+ My_Group *g = new My_Group(x, y, w, h, label);
+ return g;
+}
+
+void free_fl_group(GROUP g) {
+ delete static_cast<My_Group*>(g);
+}
+
+
+
+
+void fl_group_add(GROUP g, WIDGET item) {
+ static_cast<Fl_Group*>(g)->add(static_cast<Fl_Widget*>(item));
+}
+
+void fl_group_insert(GROUP g, WIDGET item, int place) {
+ static_cast<Fl_Group*>(g)->insert(*(static_cast<Fl_Widget*>(item)), place);
+}
+
+void fl_group_insert2(GROUP g, WIDGET item, WIDGET before) {
+ static_cast<Fl_Group*>(g)->insert(*(static_cast<Fl_Widget*>(item)), static_cast<Fl_Widget*>(before));
+}
+
+void fl_group_remove(GROUP g, WIDGET item) {
+ static_cast<Fl_Group*>(g)->remove(static_cast<Fl_Widget*>(item));
+}
+
+void fl_group_remove2(GROUP g, int place) {
+ static_cast<Fl_Group*>(g)->remove(place);
+}
+
+
+
+
+void * fl_group_child(GROUP g, int place) {
+ return static_cast<Fl_Group*>(g)->child(place);
+}
+
+int fl_group_find(GROUP g, WIDGET item) {
+ return static_cast<Fl_Group*>(g)->find(static_cast<Fl_Widget*>(item));
+}
+
+int fl_group_children(GROUP g) {
+ return static_cast<Fl_Group*>(g)->children();
+}
+
+
+
+
+unsigned int fl_group_get_clip_children(GROUP g) {
+ return static_cast<Fl_Group*>(g)->clip_children();
+}
+
+void fl_group_set_clip_children(GROUP g, int c) {
+ static_cast<Fl_Group*>(g)->clip_children(c);
+}
+
+
+
+
+void fl_group_add_resizable(GROUP g, WIDGET w) {
+ Fl_Widget &ref = *(static_cast<Fl_Widget*>(w));
+ static_cast<Fl_Group*>(g)->add_resizable(ref);
+}
+
+void * fl_group_get_resizable(GROUP g) {
+ return static_cast<Fl_Group*>(g)->resizable();
+}
+
+void fl_group_set_resizable(GROUP g, WIDGET item) {
+ static_cast<Fl_Group*>(g)->resizable(static_cast<Fl_Widget*>(item));
+}
+
+void fl_group_init_sizes(GROUP g) {
+ static_cast<Fl_Group*>(g)->init_sizes();
+}
+
+void fl_group_resize(GROUP g, int x, int y, int w, int h) {
+ static_cast<Fl_Group*>(g)->resize(x, y, w, h);
+}
+
+
+
+
+void * fl_group_get_current() {
+ return Fl_Group::current();
+}
+
+void fl_group_set_current(GROUP g) {
+ Fl_Group::current(static_cast<Fl_Group*>(g));
+}
+
+void fl_group_begin(GROUP g) {
+ static_cast<Fl_Group*>(g)->begin();
+}
+
+void fl_group_end(GROUP g) {
+ static_cast<Fl_Group*>(g)->end();
+}
+
+
+
+
+void fl_group_draw(GROUP g) {
+ static_cast<My_Group*>(g)->Fl_Group::draw();
+}
+
+void fl_group_draw_child(GROUP g, WIDGET w) {
+ Fl_Widget &ref = *(static_cast<Fl_Widget*>(w));
+ (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_child))(ref);
+}
+
+void fl_group_draw_children(GROUP g) {
+ (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_children))();
+}
+
+void fl_group_draw_outside_label(GROUP g, WIDGET w) {
+ Fl_Widget &ref = *(static_cast<Fl_Widget*>(w));
+ (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_outside_label))(ref);
+}
+
+void fl_group_update_child(GROUP g, WIDGET w) {
+ Fl_Widget &ref = *(static_cast<Fl_Widget*>(w));
+ (static_cast<Fl_Group*>(g)->*(&Friend_Group::update_child))(ref);
+}
+
+int fl_group_handle(GROUP g, int e) {
+ return static_cast<My_Group*>(g)->Fl_Group::handle(e);
+}
+
+
diff --git a/body/c_fl_group.h b/body/c_fl_group.h
new file mode 100644
index 0000000..af4559d
--- /dev/null
+++ b/body/c_fl_group.h
@@ -0,0 +1,59 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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_add(GROUP g, WIDGET item);
+extern "C" void fl_group_insert(GROUP g, WIDGET item, int place);
+extern "C" void fl_group_insert2(GROUP g, WIDGET item, WIDGET before);
+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_child(GROUP g, int place);
+extern "C" int fl_group_find(GROUP g, WIDGET item);
+extern "C" int fl_group_children(GROUP g);
+
+
+extern "C" unsigned int fl_group_get_clip_children(GROUP g);
+extern "C" void fl_group_set_clip_children(GROUP g, int c);
+
+
+extern "C" void fl_group_add_resizable(GROUP g, WIDGET w);
+extern "C" void * fl_group_get_resizable(GROUP g);
+extern "C" void fl_group_set_resizable(GROUP g, WIDGET item);
+extern "C" void fl_group_init_sizes(GROUP g);
+extern "C" void fl_group_resize(GROUP g, int x, int y, int w, int h);
+
+
+extern "C" void * fl_group_get_current();
+extern "C" void fl_group_set_current(GROUP g);
+extern "C" void fl_group_begin(GROUP g);
+extern "C" void fl_group_end(GROUP g);
+
+
+extern "C" void fl_group_draw(GROUP g);
+extern "C" void fl_group_draw_child(GROUP g, WIDGET w);
+extern "C" void fl_group_draw_children(GROUP g);
+extern "C" void fl_group_draw_outside_label(GROUP g, WIDGET w);
+extern "C" void fl_group_update_child(GROUP g, WIDGET w);
+extern "C" int fl_group_handle(GROUP g, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_help_dialog.cpp b/body/c_fl_help_dialog.cpp
new file mode 100644
index 0000000..850fb07
--- /dev/null
+++ b/body/c_fl_help_dialog.cpp
@@ -0,0 +1,105 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Help_Dialog.H>
+#include "c_fl_help_dialog.h"
+
+
+
+
+HELPDIALOG new_fl_help_dialog() {
+ Fl_Help_Dialog *d = new Fl_Help_Dialog();
+ return d;
+}
+
+void free_fl_help_dialog(HELPDIALOG d) {
+ delete static_cast<Fl_Help_Dialog*>(d);
+}
+
+
+
+
+void fl_help_dialog_show(HELPDIALOG d) {
+ static_cast<Fl_Help_Dialog*>(d)->show();
+}
+
+void fl_help_dialog_show2(HELPDIALOG d, int c, void * v) {
+ static_cast<Fl_Help_Dialog*>(d)->show(c, static_cast<char**>(v));
+}
+
+void fl_help_dialog_hide(HELPDIALOG d) {
+ static_cast<Fl_Help_Dialog*>(d)->hide();
+}
+
+int fl_help_dialog_visible(HELPDIALOG d) {
+ return static_cast<Fl_Help_Dialog*>(d)->visible();
+}
+
+
+
+
+void fl_help_dialog_set_topline_number(HELPDIALOG d, int n) {
+ static_cast<Fl_Help_Dialog*>(d)->topline(n);
+}
+
+void fl_help_dialog_set_topline_target(HELPDIALOG d, const char * t) {
+ static_cast<Fl_Help_Dialog*>(d)->topline(t);
+}
+
+
+
+
+void fl_help_dialog_load(HELPDIALOG d, const char * n) {
+ static_cast<Fl_Help_Dialog*>(d)->load(n);
+}
+
+const char * fl_help_dialog_get_value(HELPDIALOG d) {
+ return static_cast<Fl_Help_Dialog*>(d)->value();
+}
+
+void fl_help_dialog_set_value(HELPDIALOG d, const char * v) {
+ static_cast<Fl_Help_Dialog*>(d)->value(v);
+}
+
+
+
+
+int fl_help_dialog_get_textsize(HELPDIALOG d) {
+ return static_cast<Fl_Help_Dialog*>(d)->textsize();
+}
+
+void fl_help_dialog_set_textsize(HELPDIALOG d, int s) {
+ static_cast<Fl_Help_Dialog*>(d)->textsize(s);
+}
+
+
+
+
+int fl_help_dialog_get_x(HELPDIALOG d) {
+ return static_cast<Fl_Help_Dialog*>(d)->x();
+}
+
+int fl_help_dialog_get_y(HELPDIALOG d) {
+ return static_cast<Fl_Help_Dialog*>(d)->y();
+}
+
+int fl_help_dialog_get_w(HELPDIALOG d) {
+ return static_cast<Fl_Help_Dialog*>(d)->w();
+}
+
+int fl_help_dialog_get_h(HELPDIALOG d) {
+ return static_cast<Fl_Help_Dialog*>(d)->h();
+}
+
+void fl_help_dialog_resize(HELPDIALOG d, int xx, int yy, int ww, int hh) {
+ static_cast<Fl_Help_Dialog*>(d)->resize(xx, yy, ww, hh);
+}
+
+void fl_help_dialog_position(HELPDIALOG d, int xx, int yy) {
+ static_cast<Fl_Help_Dialog*>(d)->position(xx, yy);
+}
+
+
diff --git a/body/c_fl_help_dialog.h b/body/c_fl_help_dialog.h
new file mode 100644
index 0000000..ddabce8
--- /dev/null
+++ b/body/c_fl_help_dialog.h
@@ -0,0 +1,47 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_HELP_DIALOG_GUARD
+#define FL_HELP_DIALOG_GUARD
+
+
+typedef void* HELPDIALOG;
+
+
+extern "C" HELPDIALOG new_fl_help_dialog();
+extern "C" void free_fl_help_dialog(HELPDIALOG d);
+
+
+extern "C" void fl_help_dialog_show(HELPDIALOG d);
+extern "C" void fl_help_dialog_show2(HELPDIALOG d, int c, void * v);
+extern "C" void fl_help_dialog_hide(HELPDIALOG d);
+extern "C" int fl_help_dialog_visible(HELPDIALOG d);
+
+
+extern "C" void fl_help_dialog_set_topline_number(HELPDIALOG d, int n);
+extern "C" void fl_help_dialog_set_topline_target(HELPDIALOG d, const char * t);
+
+
+extern "C" void fl_help_dialog_load(HELPDIALOG d, const char * n);
+extern "C" const char * fl_help_dialog_get_value(HELPDIALOG d);
+extern "C" void fl_help_dialog_set_value(HELPDIALOG d, const char * v);
+
+
+extern "C" int fl_help_dialog_get_textsize(HELPDIALOG d);
+extern "C" void fl_help_dialog_set_textsize(HELPDIALOG d, int s);
+
+
+extern "C" int fl_help_dialog_get_x(HELPDIALOG d);
+extern "C" int fl_help_dialog_get_y(HELPDIALOG d);
+extern "C" int fl_help_dialog_get_w(HELPDIALOG d);
+extern "C" int fl_help_dialog_get_h(HELPDIALOG d);
+extern "C" void fl_help_dialog_resize(HELPDIALOG d, int xx, int yy, int ww, int hh);
+extern "C" void fl_help_dialog_position(HELPDIALOG d, int xx, int yy);
+
+
+#endif
+
+
diff --git a/body/c_fl_help_view.cpp b/body/c_fl_help_view.cpp
new file mode 100644
index 0000000..aa2fd65
--- /dev/null
+++ b/body/c_fl_help_view.cpp
@@ -0,0 +1,193 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Group.H>
+#include <FL/Fl_Help_View.H>
+#include <FL/Enumerations.H>
+#include "c_fl_help_view.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Help_View : public Fl_Help_View {
+public:
+ using Fl_Help_View::Fl_Help_View;
+
+ friend void fl_help_view_draw(HELPVIEW v);
+ friend int fl_help_view_handle(HELPVIEW v, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Help_View::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Help_View::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+HELPVIEW new_fl_help_view(int x, int y, int w, int h, char * label) {
+ My_Help_View *v = new My_Help_View(x, y, w, h, label);
+ return v;
+}
+
+void free_fl_help_view(HELPVIEW v) {
+ delete static_cast<My_Help_View*>(v);
+}
+
+
+
+
+void fl_help_view_clear_selection(HELPVIEW v) {
+ static_cast<Fl_Help_View*>(v)->clear_selection();
+}
+
+void fl_help_view_select_all(HELPVIEW v) {
+ static_cast<Fl_Help_View*>(v)->select_all();
+}
+
+
+
+
+int fl_help_view_find(HELPVIEW v, const char * s, int p) {
+ return static_cast<Fl_Help_View*>(v)->find(s, p);
+}
+
+int fl_help_view_get_leftline(HELPVIEW v) {
+ return static_cast<Fl_Help_View*>(v)->leftline();
+}
+
+void fl_help_view_set_leftline(HELPVIEW v, int t) {
+ static_cast<Fl_Help_View*>(v)->leftline(t);
+}
+
+int fl_help_view_get_topline(HELPVIEW v) {
+ return static_cast<Fl_Help_View*>(v)->topline();
+}
+
+void fl_help_view_set_topline(HELPVIEW v, int t) {
+ static_cast<Fl_Help_View*>(v)->topline(t);
+}
+
+void fl_help_view_set_topline_target(HELPVIEW v, const char * t) {
+ static_cast<Fl_Help_View*>(v)->topline(t);
+}
+
+
+
+
+const char * fl_help_view_directory(HELPVIEW v) {
+ return static_cast<Fl_Help_View*>(v)->directory();
+}
+
+const char * fl_help_view_filename(HELPVIEW v) {
+ return static_cast<Fl_Help_View*>(v)->filename();
+}
+
+int fl_help_view_load(HELPVIEW v, const char * f) {
+ return static_cast<Fl_Help_View*>(v)->load(f);
+}
+
+const char * fl_help_view_title(HELPVIEW v) {
+ return static_cast<Fl_Help_View*>(v)->title();
+}
+
+const char * fl_help_view_get_value(HELPVIEW v) {
+ return static_cast<Fl_Help_View*>(v)->value();
+}
+
+void fl_help_view_set_value(HELPVIEW v, const char * t) {
+ static_cast<Fl_Help_View*>(v)->value(t);
+}
+
+void fl_help_view_link(HELPVIEW v, void * f) {
+ static_cast<Fl_Help_View*>(v)->link(reinterpret_cast<Fl_Help_Func*>(f));
+}
+
+
+
+
+int fl_help_view_get_scrollbar_size(HELPVIEW v) {
+ return static_cast<Fl_Help_View*>(v)->scrollbar_size();
+}
+
+void fl_help_view_set_scrollbar_size(HELPVIEW v, int s) {
+ static_cast<Fl_Help_View*>(v)->scrollbar_size(s);
+}
+
+int fl_help_view_get_size(HELPVIEW v) {
+ return static_cast<Fl_Help_View*>(v)->size();
+}
+
+void fl_help_view_set_size(HELPVIEW v, int w, int h) {
+ static_cast<Fl_Help_View*>(v)->size(w, h);
+}
+
+void fl_help_view_resize(HELPVIEW v, int x, int y, int w, int h) {
+ static_cast<Fl_Help_View*>(v)->resize(x, y, w, h);
+}
+
+unsigned int fl_help_view_get_textcolor(HELPVIEW v) {
+ return static_cast<Fl_Help_View*>(v)->textcolor();
+}
+
+void fl_help_view_set_textcolor(HELPVIEW v, unsigned int c) {
+ static_cast<Fl_Help_View*>(v)->textcolor(c);
+}
+
+int fl_help_view_get_textfont(HELPVIEW v) {
+ return static_cast<Fl_Help_View*>(v)->textfont();
+}
+
+void fl_help_view_set_textfont(HELPVIEW v, int f) {
+ static_cast<Fl_Help_View*>(v)->textfont(f);
+}
+
+int fl_help_view_get_textsize(HELPVIEW v) {
+ return static_cast<Fl_Help_View*>(v)->textsize();
+}
+
+void fl_help_view_set_textsize(HELPVIEW v, int s) {
+ static_cast<Fl_Help_View*>(v)->textsize(s);
+}
+
+
+
+
+void fl_help_view_draw(HELPVIEW v) {
+#if FL_ABI_VERSION >= 10303
+ static_cast<My_Help_View*>(v)->Fl_Help_View::draw();
+#else
+ static_cast<My_Help_View*>(v)->Fl_Group::draw();
+#endif
+}
+
+int fl_help_view_handle(HELPVIEW v, int e) {
+#if FL_ABI_VERSION >= 10303
+ return static_cast<My_Help_View*>(v)->Fl_Help_View::handle(e);
+#else
+ return static_cast<My_Help_View*>(v)->Fl_Group::handle(e);
+#endif
+}
+
+
diff --git a/body/c_fl_help_view.h b/body/c_fl_help_view.h
new file mode 100644
index 0000000..b16b344
--- /dev/null
+++ b/body/c_fl_help_view.h
@@ -0,0 +1,58 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_HELP_VIEW_GUARD
+#define FL_HELP_VIEW_GUARD
+
+
+typedef void* HELPVIEW;
+
+
+extern "C" HELPVIEW new_fl_help_view(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_help_view(HELPVIEW v);
+
+
+extern "C" void fl_help_view_clear_selection(HELPVIEW v);
+extern "C" void fl_help_view_select_all(HELPVIEW v);
+
+
+extern "C" int fl_help_view_find(HELPVIEW v, const char * s, int p);
+extern "C" int fl_help_view_get_leftline(HELPVIEW v);
+extern "C" void fl_help_view_set_leftline(HELPVIEW v, int t);
+extern "C" int fl_help_view_get_topline(HELPVIEW v);
+extern "C" void fl_help_view_set_topline(HELPVIEW v, int t);
+extern "C" void fl_help_view_set_topline_target(HELPVIEW v, const char * t);
+
+
+extern "C" const char * fl_help_view_directory(HELPVIEW v);
+extern "C" const char * fl_help_view_filename(HELPVIEW v);
+extern "C" int fl_help_view_load(HELPVIEW v, const char * f);
+extern "C" const char * fl_help_view_title(HELPVIEW v);
+extern "C" const char * fl_help_view_get_value(HELPVIEW v);
+extern "C" void fl_help_view_set_value(HELPVIEW v, const char * t);
+extern "C" void fl_help_view_link(HELPVIEW v, void * f);
+
+
+extern "C" int fl_help_view_get_scrollbar_size(HELPVIEW v);
+extern "C" void fl_help_view_set_scrollbar_size(HELPVIEW v, int s);
+extern "C" int fl_help_view_get_size(HELPVIEW v);
+extern "C" void fl_help_view_set_size(HELPVIEW v, int w, int h);
+extern "C" void fl_help_view_resize(HELPVIEW v, int x, int y, int w, int h);
+extern "C" unsigned int fl_help_view_get_textcolor(HELPVIEW v);
+extern "C" void fl_help_view_set_textcolor(HELPVIEW v, unsigned int c);
+extern "C" int fl_help_view_get_textfont(HELPVIEW v);
+extern "C" void fl_help_view_set_textfont(HELPVIEW v, int f);
+extern "C" int fl_help_view_get_textsize(HELPVIEW v);
+extern "C" void fl_help_view_set_textsize(HELPVIEW v, int s);
+
+
+extern "C" void fl_help_view_draw(HELPVIEW v);
+extern "C" int fl_help_view_handle(HELPVIEW v, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_hold_browser.cpp b/body/c_fl_hold_browser.cpp
new file mode 100644
index 0000000..023e9ec
--- /dev/null
+++ b/body/c_fl_hold_browser.cpp
@@ -0,0 +1,265 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Hold_Browser.H>
+#include "c_fl_hold_browser.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" int browser_full_width_hook(void * b);
+extern "C" int browser_full_height_hook(void * b);
+extern "C" int browser_incr_height_hook(void * b);
+extern "C" int browser_item_quick_height_hook(void * b, void * i);
+
+extern "C" int browser_item_width_hook(void * b, void * i);
+extern "C" int browser_item_height_hook(void * b, void * i);
+extern "C" void * browser_item_first_hook(void * b);
+extern "C" void * browser_item_last_hook(void * b);
+extern "C" void * browser_item_next_hook(void * b, void * i);
+extern "C" void * browser_item_prev_hook(void * b, void * i);
+extern "C" void * browser_item_at_hook(void * b, int n);
+extern "C" void browser_item_select_hook(void * b, void * i, int s);
+extern "C" int browser_item_selected_hook(void * b, void * i);
+extern "C" void browser_item_swap_hook(void * b, void * one, void * two);
+extern "C" const char * browser_item_text_hook(void * b, void * i);
+extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h);
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Hold_Browser : public Fl_Hold_Browser {
+public:
+ using Fl_Hold_Browser::Fl_Hold_Browser;
+
+ friend int fl_hold_browser_item_width(HOLDBROWSER b, void * item);
+ friend int fl_hold_browser_item_height(HOLDBROWSER b, void * item);
+ friend void * fl_hold_browser_item_first(HOLDBROWSER b);
+ friend void * fl_hold_browser_item_last(HOLDBROWSER b);
+ friend void * fl_hold_browser_item_next(HOLDBROWSER b, void * item);
+ friend void * fl_hold_browser_item_prev(HOLDBROWSER b, void * item);
+ friend void * fl_hold_browser_item_at(HOLDBROWSER b, int index);
+ friend void fl_hold_browser_item_select(HOLDBROWSER b, void * item, int val);
+ friend int fl_hold_browser_item_selected(HOLDBROWSER b, void * item);
+ friend void fl_hold_browser_item_swap(HOLDBROWSER b, void * x, void * y);
+ friend const char * fl_hold_browser_item_text(HOLDBROWSER b, void * item);
+ friend void fl_hold_browser_item_draw(HOLDBROWSER b, void * item, int x, int y, int w, int h);
+
+ friend int fl_hold_browser_full_width(HOLDBROWSER c);
+ friend int fl_hold_browser_full_height(HOLDBROWSER c);
+ friend int fl_hold_browser_incr_height(HOLDBROWSER c);
+ friend int fl_hold_browser_item_quick_height(HOLDBROWSER c, void * i);
+
+ friend void fl_hold_browser_draw(HOLDBROWSER b);
+
+ int handle(int e);
+
+protected:
+ int full_width() const;
+ int full_height() const;
+ int incr_height() const;
+ int item_quick_height(void * item) const;
+
+ int item_width(void * item) const;
+ int item_height(void * item) const;
+ void * item_first() const;
+ void * item_last() const;
+ void * item_next(void * item) const;
+ void * item_prev(void * item) const;
+ void * item_at(int index) const;
+ void item_select(void * item, int val=1);
+ int item_selected(void * item) const;
+ void item_swap(void * a, void * b);
+ const char * item_text(void * item) const;
+ void item_draw(void * item, int x, int y, int w, int h) const;
+
+ void draw();
+};
+
+
+int My_Hold_Browser::full_width() const {
+ return browser_full_width_hook(this->user_data());
+}
+
+int My_Hold_Browser::full_height() const {
+ return browser_full_height_hook(this->user_data());
+}
+
+int My_Hold_Browser::incr_height() const {
+ return browser_incr_height_hook(this->user_data());
+}
+
+int My_Hold_Browser::item_quick_height(void * item) const {
+ return browser_item_quick_height_hook(this->user_data(), item);
+}
+
+
+int My_Hold_Browser::item_width(void * item) const {
+ return browser_item_width_hook(this->user_data(), item);
+}
+
+int My_Hold_Browser::item_height(void * item) const {
+ return browser_item_height_hook(this->user_data(), item);
+}
+
+void * My_Hold_Browser::item_first() const {
+ return browser_item_first_hook(this->user_data());
+}
+
+void * My_Hold_Browser::item_last() const {
+ return browser_item_last_hook(this->user_data());
+}
+
+void * My_Hold_Browser::item_next(void * item) const {
+ return browser_item_next_hook(this->user_data(), item);
+}
+
+void * My_Hold_Browser::item_prev(void * item) const {
+ return browser_item_prev_hook(this->user_data(), item);
+}
+
+void * My_Hold_Browser::item_at(int index) const {
+ return browser_item_at_hook(this->user_data(), index);
+}
+
+void My_Hold_Browser::item_select(void * item, int val) {
+ browser_item_select_hook(this->user_data(), item, val);
+}
+
+int My_Hold_Browser::item_selected(void * item) const {
+ return browser_item_selected_hook(this->user_data(), item);
+}
+
+void My_Hold_Browser::item_swap(void * a, void * b) {
+ browser_item_swap_hook(this->user_data(), a, b);
+}
+
+const char * My_Hold_Browser::item_text(void * item) const {
+ return browser_item_text_hook(this->user_data(), item);
+}
+
+void My_Hold_Browser::item_draw(void * item, int x, int y, int w, int h) const {
+ browser_item_draw_hook(this->user_data(), item, x, y, w, h);
+}
+
+
+void My_Hold_Browser::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Hold_Browser::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API begins here
+
+HOLDBROWSER new_fl_hold_browser(int x, int y, int w, int h, char * label) {
+ My_Hold_Browser *b = new My_Hold_Browser(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_hold_browser(HOLDBROWSER b) {
+ delete static_cast<My_Hold_Browser*>(b);
+}
+
+
+
+
+// These have to be reimplemented due to relying on custom class extensions
+
+
+int fl_hold_browser_full_height(HOLDBROWSER c) {
+ return static_cast<My_Hold_Browser*>(c)->Fl_Hold_Browser::full_height();
+}
+
+int fl_hold_browser_incr_height(HOLDBROWSER c) {
+ return static_cast<My_Hold_Browser*>(c)->Fl_Hold_Browser::incr_height();
+}
+
+
+
+
+int fl_hold_browser_item_width(HOLDBROWSER b, void * item) {
+ return static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_width(item);
+}
+
+int fl_hold_browser_item_height(HOLDBROWSER b, void * item) {
+ return static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_height(item);
+}
+
+void * fl_hold_browser_item_first(HOLDBROWSER b) {
+ return static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_first();
+}
+
+void * fl_hold_browser_item_last(HOLDBROWSER b) {
+ return static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_last();
+}
+
+void * fl_hold_browser_item_next(HOLDBROWSER b, void * item) {
+ return static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_next(item);
+}
+
+void * fl_hold_browser_item_prev(HOLDBROWSER b, void * item) {
+ return static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_prev(item);
+}
+
+void * fl_hold_browser_item_at(HOLDBROWSER b, int index) {
+ return static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_at(index);
+}
+
+void fl_hold_browser_item_select(HOLDBROWSER b, void * item, int val) {
+ static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_select(item, val);
+}
+
+int fl_hold_browser_item_selected(HOLDBROWSER b, void * item) {
+ return static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_selected(item);
+}
+
+void fl_hold_browser_item_swap(HOLDBROWSER b, void * x, void * y) {
+ static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_swap(x, y);
+}
+
+const char * fl_hold_browser_item_text(HOLDBROWSER b, void * item) {
+ return static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_text(item);
+}
+
+void fl_hold_browser_item_draw(HOLDBROWSER b, void * item, int x, int y, int w, int h) {
+ static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::item_draw(item, x, y, w, h);
+}
+
+
+
+
+int fl_hold_browser_full_width(HOLDBROWSER c) {
+ return static_cast<My_Hold_Browser*>(c)->Fl_Hold_Browser::full_width();
+}
+
+int fl_hold_browser_item_quick_height(HOLDBROWSER c, void * i) {
+ return static_cast<My_Hold_Browser*>(c)->Fl_Hold_Browser::item_quick_height(i);
+}
+
+
+
+
+void fl_hold_browser_draw(HOLDBROWSER b) {
+ static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::draw();
+}
+
+int fl_hold_browser_handle(HOLDBROWSER b, int e) {
+ return static_cast<My_Hold_Browser*>(b)->Fl_Hold_Browser::handle(e);
+}
+
+
diff --git a/body/c_fl_hold_browser.h b/body/c_fl_hold_browser.h
new file mode 100644
index 0000000..6f295c6
--- /dev/null
+++ b/body/c_fl_hold_browser.h
@@ -0,0 +1,48 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_HOLD_BROWSER_GUARD
+#define FL_HOLD_BROWSER_GUARD
+
+
+typedef void* HOLDBROWSER;
+
+
+extern "C" HOLDBROWSER new_fl_hold_browser(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_hold_browser(HOLDBROWSER b);
+
+
+// reimp below here
+
+extern "C" int fl_hold_browser_full_height(HOLDBROWSER c);
+extern "C" int fl_hold_browser_incr_height(HOLDBROWSER c);
+
+
+extern "C" int fl_hold_browser_item_width(HOLDBROWSER b, void * item);
+extern "C" int fl_hold_browser_item_height(HOLDBROWSER b, void * item);
+extern "C" void * fl_hold_browser_item_first(HOLDBROWSER b);
+extern "C" void * fl_hold_browser_item_last(HOLDBROWSER b);
+extern "C" void * fl_hold_browser_item_next(HOLDBROWSER b, void * item);
+extern "C" void * fl_hold_browser_item_prev(HOLDBROWSER b, void * item);
+extern "C" void * fl_hold_browser_item_at(HOLDBROWSER b, int index);
+extern "C" void fl_hold_browser_item_select(HOLDBROWSER b, void * item, int val=1);
+extern "C" int fl_hold_browser_item_selected(HOLDBROWSER b, void * item);
+extern "C" void fl_hold_browser_item_swap(HOLDBROWSER b, void * x, void * y);
+extern "C" const char * fl_hold_browser_item_text(HOLDBROWSER b, void * item);
+extern "C" void fl_hold_browser_item_draw(HOLDBROWSER b, void * item, int x, int y, int w, int h);
+
+
+extern "C" int fl_hold_browser_full_width(HOLDBROWSER c);
+extern "C" int fl_hold_browser_item_quick_height(HOLDBROWSER c, void * i);
+
+
+extern "C" void fl_hold_browser_draw(HOLDBROWSER b);
+extern "C" int fl_hold_browser_handle(HOLDBROWSER b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_hor_fill_slider.cpp b/body/c_fl_hor_fill_slider.cpp
new file mode 100644
index 0000000..9cd6ae2
--- /dev/null
+++ b/body/c_fl_hor_fill_slider.cpp
@@ -0,0 +1,74 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Hor_Fill_Slider.H>
+#include "c_fl_hor_fill_slider.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Hor_Fill_Slider : public Fl_Hor_Fill_Slider {
+public:
+ using Fl_Hor_Fill_Slider::Fl_Hor_Fill_Slider;
+
+ friend void fl_hor_fill_slider_draw(HORFILLSLIDER s);
+ friend int fl_hor_fill_slider_handle(HORFILLSLIDER s, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Hor_Fill_Slider::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Hor_Fill_Slider::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Hor_Fill_Slider::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+HORFILLSLIDER new_fl_hor_fill_slider(int x, int y, int w, int h, char* label) {
+ My_Hor_Fill_Slider *s = new My_Hor_Fill_Slider(x, y, w, h, label);
+ return s;
+}
+
+void free_fl_hor_fill_slider(HORFILLSLIDER s) {
+ delete static_cast<My_Hor_Fill_Slider*>(s);
+}
+
+
+
+
+void fl_hor_fill_slider_draw(HORFILLSLIDER s) {
+ static_cast<My_Hor_Fill_Slider*>(s)->Fl_Hor_Fill_Slider::draw();
+}
+
+int fl_hor_fill_slider_handle(HORFILLSLIDER s, int e) {
+ return static_cast<My_Hor_Fill_Slider*>(s)->Fl_Hor_Fill_Slider::handle(e);
+}
+
+
diff --git a/body/c_fl_hor_fill_slider.h b/body/c_fl_hor_fill_slider.h
new file mode 100644
index 0000000..d698a93
--- /dev/null
+++ b/body/c_fl_hor_fill_slider.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_HOR_FILL_SLIDER_GUARD
+#define FL_HOR_FILL_SLIDER_GUARD
+
+
+typedef void* HORFILLSLIDER;
+
+
+extern "C" HORFILLSLIDER new_fl_hor_fill_slider(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_hor_fill_slider(HORFILLSLIDER s);
+
+
+extern "C" void fl_hor_fill_slider_draw(HORFILLSLIDER s);
+extern "C" int fl_hor_fill_slider_handle(HORFILLSLIDER s, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_hor_nice_slider.cpp b/body/c_fl_hor_nice_slider.cpp
new file mode 100644
index 0000000..29b271d
--- /dev/null
+++ b/body/c_fl_hor_nice_slider.cpp
@@ -0,0 +1,74 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Hor_Nice_Slider.H>
+#include "c_fl_hor_nice_slider.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Hor_Nice_Slider : public Fl_Hor_Nice_Slider {
+public:
+ using Fl_Hor_Nice_Slider::Fl_Hor_Nice_Slider;
+
+ friend void fl_hor_nice_slider_draw(HORNICESLIDER s);
+ friend int fl_hor_nice_slider_handle(HORNICESLIDER s, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Hor_Nice_Slider::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Hor_Nice_Slider::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Hor_Nice_Slider::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+HORNICESLIDER new_fl_hor_nice_slider(int x, int y, int w, int h, char* label) {
+ My_Hor_Nice_Slider *s = new My_Hor_Nice_Slider(x, y, w, h, label);
+ return s;
+}
+
+void free_fl_hor_nice_slider(HORNICESLIDER s) {
+ delete static_cast<My_Hor_Nice_Slider*>(s);
+}
+
+
+
+
+void fl_hor_nice_slider_draw(HORNICESLIDER s) {
+ static_cast<My_Hor_Nice_Slider*>(s)->Fl_Hor_Nice_Slider::draw();
+}
+
+int fl_hor_nice_slider_handle(HORNICESLIDER s, int e) {
+ return static_cast<My_Hor_Nice_Slider*>(s)->Fl_Hor_Nice_Slider::handle(e);
+}
+
+
diff --git a/body/c_fl_hor_nice_slider.h b/body/c_fl_hor_nice_slider.h
new file mode 100644
index 0000000..a4e3bc1
--- /dev/null
+++ b/body/c_fl_hor_nice_slider.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_HOR_NICE_SLIDER_GUARD
+#define FL_HOR_NICE_SLIDER_GUARD
+
+
+typedef void* HORNICESLIDER;
+
+
+extern "C" HORNICESLIDER new_fl_hor_nice_slider(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_hor_nice_slider(HORNICESLIDER s);
+
+
+extern "C" void fl_hor_nice_slider_draw(HORNICESLIDER s);
+extern "C" int fl_hor_nice_slider_handle(HORNICESLIDER s, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_hor_value_slider.cpp b/body/c_fl_hor_value_slider.cpp
new file mode 100644
index 0000000..cff16f6
--- /dev/null
+++ b/body/c_fl_hor_value_slider.cpp
@@ -0,0 +1,74 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Hor_Value_Slider.H>
+#include "c_fl_hor_value_slider.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Hor_Value_Slider : public Fl_Hor_Value_Slider {
+public:
+ using Fl_Hor_Value_Slider::Fl_Hor_Value_Slider;
+
+ friend void fl_hor_value_slider_draw(HORVALUESLIDER s);
+ friend int fl_hor_value_slider_handle(HORVALUESLIDER s, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Hor_Value_Slider::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Hor_Value_Slider::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Hor_Value_Slider::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+HORVALUESLIDER new_fl_hor_value_slider(int x, int y, int w, int h, char* label) {
+ My_Hor_Value_Slider *s = new My_Hor_Value_Slider(x, y, w, h, label);
+ return s;
+}
+
+void free_fl_hor_value_slider(HORVALUESLIDER s) {
+ delete static_cast<My_Hor_Value_Slider*>(s);
+}
+
+
+
+
+void fl_hor_value_slider_draw(HORVALUESLIDER s) {
+ static_cast<My_Hor_Value_Slider*>(s)->Fl_Hor_Value_Slider::draw();
+}
+
+int fl_hor_value_slider_handle(HORVALUESLIDER s, int e) {
+ return static_cast<My_Hor_Value_Slider*>(s)->Fl_Hor_Value_Slider::handle(e);
+}
+
+
diff --git a/body/c_fl_hor_value_slider.h b/body/c_fl_hor_value_slider.h
new file mode 100644
index 0000000..6257313
--- /dev/null
+++ b/body/c_fl_hor_value_slider.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_HOR_VALUE_SLIDER_GUARD
+#define FL_HOR_VALUE_SLIDER_GUARD
+
+
+typedef void* HORVALUESLIDER;
+
+
+extern "C" HORVALUESLIDER new_fl_hor_value_slider(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_hor_value_slider(HORVALUESLIDER s);
+
+
+extern "C" void fl_hor_value_slider_draw(HORVALUESLIDER s);
+extern "C" int fl_hor_value_slider_handle(HORVALUESLIDER s, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_horizontal_slider.cpp b/body/c_fl_horizontal_slider.cpp
new file mode 100644
index 0000000..6a0ac22
--- /dev/null
+++ b/body/c_fl_horizontal_slider.cpp
@@ -0,0 +1,74 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Hor_Slider.H>
+#include "c_fl_horizontal_slider.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Horizontal_Slider : public Fl_Hor_Slider {
+public:
+ using Fl_Hor_Slider::Fl_Hor_Slider;
+
+ friend void fl_horizontal_slider_draw(HORIZONTALSLIDER s);
+ friend int fl_horizontal_slider_handle(HORIZONTALSLIDER s, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Horizontal_Slider::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Horizontal_Slider::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Horizontal_Slider::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+HORIZONTALSLIDER new_fl_horizontal_slider(int x, int y, int w, int h, char* label) {
+ My_Horizontal_Slider *s = new My_Horizontal_Slider(x, y, w, h, label);
+ return s;
+}
+
+void free_fl_horizontal_slider(HORIZONTALSLIDER s) {
+ delete static_cast<My_Horizontal_Slider*>(s);
+}
+
+
+
+
+void fl_horizontal_slider_draw(HORIZONTALSLIDER s) {
+ static_cast<My_Horizontal_Slider*>(s)->Fl_Hor_Slider::draw();
+}
+
+int fl_horizontal_slider_handle(HORIZONTALSLIDER s, int e) {
+ return static_cast<My_Horizontal_Slider*>(s)->Fl_Hor_Slider::handle(e);
+}
+
+
diff --git a/body/c_fl_horizontal_slider.h b/body/c_fl_horizontal_slider.h
new file mode 100644
index 0000000..96dd11a
--- /dev/null
+++ b/body/c_fl_horizontal_slider.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_HORIZONTAL_SLIDER_GUARD
+#define FL_HORIZONTAL_SLIDER_GUARD
+
+
+typedef void* HORIZONTALSLIDER;
+
+
+extern "C" HORIZONTALSLIDER new_fl_horizontal_slider(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_horizontal_slider(HORIZONTALSLIDER s);
+
+
+extern "C" void fl_horizontal_slider_draw(HORIZONTALSLIDER s);
+extern "C" int fl_horizontal_slider_handle(HORIZONTALSLIDER s, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_image.cpp b/body/c_fl_image.cpp
new file mode 100644
index 0000000..328c187
--- /dev/null
+++ b/body/c_fl_image.cpp
@@ -0,0 +1,142 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Image.H>
+#include "c_fl_image.h"
+
+
+
+
+class My_Image : public Fl_Image {
+ public:
+ using Fl_Image::Fl_Image;
+ friend void fl_image_draw_empty(IMAGE i, int x, int y);
+};
+
+
+
+
+IMAGE new_fl_image(int w, int h, int d) {
+ My_Image *i = new My_Image(w, h, d);
+ return i;
+}
+
+void free_fl_image(IMAGE i) {
+ delete static_cast<My_Image*>(i);
+}
+
+
+
+
+int fl_image_get_rgb_scaling() {
+ return Fl_Image::RGB_scaling();
+}
+
+void fl_image_set_rgb_scaling(int t) {
+ Fl_Image::RGB_scaling(static_cast<Fl_RGB_Scaling>(t));
+}
+
+IMAGE fl_image_copy(IMAGE i, int w, int h) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Image*>(i)->Fl_Image::copy(w, h);
+}
+
+IMAGE fl_image_copy2(IMAGE i) {
+ return static_cast<Fl_Image*>(i)->copy();
+}
+
+
+
+
+void fl_image_color_average(IMAGE i, int c, float b) {
+ // virtual so disable dispatch
+ static_cast<Fl_Image*>(i)->Fl_Image::color_average(c, b);
+}
+
+void fl_image_desaturate(IMAGE i) {
+ // virtual so disable dispatch
+ static_cast<Fl_Image*>(i)->Fl_Image::desaturate();
+}
+
+
+
+
+void fl_image_inactive(IMAGE i) {
+ static_cast<Fl_Image*>(i)->inactive();
+}
+
+int fl_image_fail(IMAGE i) {
+ switch (static_cast<Fl_Image*>(i)->fail()) {
+ case Fl_Image::ERR_NO_IMAGE:
+ return 1;
+ case Fl_Image::ERR_FILE_ACCESS:
+ return 2;
+ case Fl_Image::ERR_FORMAT:
+ return 3;
+ default:
+ return 0;
+ }
+}
+
+void fl_image_uncache(IMAGE i) {
+ // virtual so disable dispatch
+ static_cast<Fl_Image*>(i)->Fl_Image::uncache();
+}
+
+
+
+
+int fl_image_w(IMAGE i) {
+ return static_cast<Fl_Image*>(i)->w();
+}
+
+int fl_image_h(IMAGE i) {
+ return static_cast<Fl_Image*>(i)->h();
+}
+
+int fl_image_d(IMAGE i) {
+ return static_cast<Fl_Image*>(i)->d();
+}
+
+int fl_image_ld(IMAGE i) {
+ return static_cast<Fl_Image*>(i)->ld();
+}
+
+int fl_image_count(IMAGE i) {
+ return static_cast<Fl_Image*>(i)->count();
+}
+
+
+
+
+const void * fl_image_data(IMAGE i) {
+ return static_cast<Fl_Image*>(i)->data();
+}
+
+char fl_image_get_pixel(char *c, int off) {
+ return c[off];
+}
+
+void fl_image_set_pixel(char *c, int off, char val) {
+ c[off] = val;
+}
+
+
+
+
+void fl_image_draw(IMAGE i, int x, int y) {
+ static_cast<Fl_Image*>(i)->draw(x, y);
+}
+
+void fl_image_draw2(IMAGE i, int x, int y, int w, int h, int cx, int cy) {
+ // virtual so disable dispatch
+ static_cast<Fl_Image*>(i)->Fl_Image::draw(x, y, w, h, cx, cy);
+}
+
+void fl_image_draw_empty(IMAGE i, int x, int y) {
+ static_cast<My_Image*>(i)->draw_empty(x, y);
+}
+
diff --git a/body/c_fl_image.h b/body/c_fl_image.h
new file mode 100644
index 0000000..ee96b7a
--- /dev/null
+++ b/body/c_fl_image.h
@@ -0,0 +1,52 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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_get_rgb_scaling();
+extern "C" void fl_image_set_rgb_scaling(int t);
+extern "C" IMAGE fl_image_copy(IMAGE i, int w, int h);
+extern "C" IMAGE fl_image_copy2(IMAGE i);
+
+
+extern "C" void fl_image_color_average(IMAGE i, int c, float b);
+extern "C" void fl_image_desaturate(IMAGE i);
+
+
+extern "C" void fl_image_inactive(IMAGE i);
+extern "C" int fl_image_fail(IMAGE i);
+extern "C" void fl_image_uncache(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);
+extern "C" int fl_image_ld(IMAGE i);
+extern "C" int fl_image_count(IMAGE i);
+
+
+extern "C" const void * fl_image_data(IMAGE i);
+extern "C" char fl_image_get_pixel(char *c, int off);
+extern "C" void fl_image_set_pixel(char *c, int off, char val);
+
+
+extern "C" void fl_image_draw(IMAGE i, int x, int y);
+extern "C" void fl_image_draw2(IMAGE i, int x, int y, int w, int h, int cx, int cy);
+extern "C" void fl_image_draw_empty(IMAGE i, int x, int y);
+
+
+#endif
+
+
diff --git a/body/c_fl_image_surface.cpp b/body/c_fl_image_surface.cpp
new file mode 100644
index 0000000..51df5fb
--- /dev/null
+++ b/body/c_fl_image_surface.cpp
@@ -0,0 +1,55 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Image_Surface.H>
+#include <FL/Fl_Widget.H>
+#include <FL/Fl_Window.H>
+#include "c_fl_image_surface.h"
+
+
+
+
+// Flattened C API
+
+IMAGESURFACE new_fl_image_surface(int w, int h, int r) {
+ Fl_Image_Surface *s = new Fl_Image_Surface(w,h,r);
+ return s;
+}
+
+void free_fl_image_surface(IMAGESURFACE s) {
+ delete static_cast<Fl_Image_Surface*>(s);
+}
+
+
+
+
+void fl_image_surface_draw(IMAGESURFACE s, void * w, int dx, int dy) {
+ static_cast<Fl_Image_Surface*>(s)->draw(static_cast<Fl_Widget*>(w),dx,dy);
+}
+
+void fl_image_surface_draw_decorated_window(IMAGESURFACE s, void * w, int dx, int dy) {
+ static_cast<Fl_Image_Surface*>(s)->draw_decorated_window(static_cast<Fl_Window*>(w),dx,dy);
+}
+
+
+
+
+void * fl_image_surface_image(IMAGESURFACE s) {
+ return static_cast<Fl_Image_Surface*>(s)->image();
+}
+
+void * fl_image_surface_highres_image(IMAGESURFACE s) {
+ return static_cast<Fl_Image_Surface*>(s)->highres_image();
+}
+
+
+
+
+void fl_image_surface_set_current(IMAGESURFACE s) {
+ static_cast<Fl_Image_Surface*>(s)->set_current();
+}
+
+
diff --git a/body/c_fl_image_surface.h b/body/c_fl_image_surface.h
new file mode 100644
index 0000000..a4ffd65
--- /dev/null
+++ b/body/c_fl_image_surface.h
@@ -0,0 +1,31 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_IMAGE_SURFACE_GUARD
+#define FL_IMAGE_SURFACE_GUARD
+
+
+typedef void* IMAGESURFACE;
+
+
+extern "C" IMAGESURFACE new_fl_image_surface(int w, int h, int r);
+extern "C" void free_fl_image_surface(IMAGESURFACE s);
+
+
+extern "C" void fl_image_surface_draw(IMAGESURFACE s, void * w, int dx, int dy);
+extern "C" void fl_image_surface_draw_decorated_window(IMAGESURFACE s, void * w, int dx, int dy);
+
+
+extern "C" void * fl_image_surface_image(IMAGESURFACE s);
+extern "C" void * fl_image_surface_highres_image(IMAGESURFACE s);
+
+
+extern "C" void fl_image_surface_set_current(IMAGESURFACE s);
+
+
+#endif
+
+
diff --git a/body/c_fl_input.cpp b/body/c_fl_input.cpp
new file mode 100644
index 0000000..6fa6b2d
--- /dev/null
+++ b/body/c_fl_input.cpp
@@ -0,0 +1,82 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Input.H>
+#include "c_fl_input.h"
+
+
+
+
+// Telprot stopovers
+
+extern "C" void text_input_extra_init_hook(void * aobj, int x, int y, int w, int h, const char * l);
+void fl_text_input_extra_init(void * adaobj, int x, int y, int w, int h, const char * label) {
+ text_input_extra_init_hook(adaobj, x, y, w, h, label);
+}
+
+extern "C" void text_input_extra_final_hook(void * aobj);
+void fl_text_input_extra_final(void * adaobj) {
+ text_input_extra_final_hook(adaobj);
+}
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Text_Input : public Fl_Input {
+public:
+ using Fl_Input::Fl_Input;
+
+ friend void fl_text_input_draw(TEXTINPUT t);
+ friend int fl_text_input_handle(TEXTINPUT t, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Text_Input::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Text_Input::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+TEXTINPUT new_fl_text_input(int x, int y, int w, int h, char * label) {
+ My_Text_Input * t = new My_Text_Input(x, y, w, h, label);
+ return t;
+}
+
+void free_fl_text_input(TEXTINPUT t) {
+ delete static_cast<My_Text_Input*>(t);
+}
+
+
+
+
+void fl_text_input_draw(TEXTINPUT t) {
+ static_cast<My_Text_Input*>(t)->Fl_Input::draw();
+}
+
+int fl_text_input_handle(TEXTINPUT t, int e) {
+ return static_cast<My_Text_Input*>(t)->Fl_Input::handle(e);
+}
+
+
diff --git a/body/c_fl_input.h b/body/c_fl_input.h
new file mode 100644
index 0000000..06a8a0c
--- /dev/null
+++ b/body/c_fl_input.h
@@ -0,0 +1,29 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_TEXT_INPUT_GUARD
+#define FL_TEXT_INPUT_GUARD
+
+
+extern "C" void fl_text_input_extra_init
+ (void * adaobj, int x, int y, int w, int h, const char * label);
+extern "C" void fl_text_input_extra_final(void * adaobj);
+
+
+typedef void* TEXTINPUT;
+
+
+extern "C" TEXTINPUT new_fl_text_input(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_text_input(TEXTINPUT t);
+
+
+extern "C" void fl_text_input_draw(TEXTINPUT t);
+extern "C" int fl_text_input_handle(TEXTINPUT t, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_input_.cpp b/body/c_fl_input_.cpp
new file mode 100644
index 0000000..7fe0556
--- /dev/null
+++ b/body/c_fl_input_.cpp
@@ -0,0 +1,249 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Input_.H>
+#include "c_fl_input_.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Input : public Fl_Input_ {
+public:
+ using Fl_Input_::Fl_Input_;
+
+ friend void fl_input_draw(INPUT i);
+ friend int fl_input_handle(INPUT i, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Input::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Input::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+INPUT new_fl_input(int x, int y, int w, int h, char* label) {
+ My_Input *i = new My_Input(x, y, w, h, label);
+ return i;
+}
+
+void free_fl_input(INPUT i) {
+ delete static_cast<My_Input*>(i);
+}
+
+
+
+
+int fl_input_copy(INPUT i, int c) {
+ return static_cast<Fl_Input_*>(i)->copy(c);
+}
+
+int fl_input_cut(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->cut();
+}
+
+int fl_input_cut2(INPUT i, int b) {
+ return static_cast<Fl_Input_*>(i)->cut(b);
+}
+
+int fl_input_cut3(INPUT i, int a, int b) {
+ return static_cast<Fl_Input_*>(i)->cut(a,b);
+}
+
+int fl_input_copy_cuts(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->copy_cuts();
+}
+
+int fl_input_undo(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->undo();
+}
+
+
+
+
+int fl_input_get_readonly(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->readonly();
+}
+
+void fl_input_set_readonly(INPUT i, int t) {
+ static_cast<Fl_Input_*>(i)->readonly(t);
+}
+
+int fl_input_get_tab_nav(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->tab_nav();
+}
+
+void fl_input_set_tab_nav(INPUT i, int t) {
+ static_cast<Fl_Input_*>(i)->tab_nav(t);
+}
+
+int fl_input_get_wrap(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->wrap();
+}
+
+void fl_input_set_wrap(INPUT i, int t) {
+ static_cast<Fl_Input_*>(i)->wrap(t);
+}
+
+
+
+
+int fl_input_get_input_type(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->input_type();
+}
+
+void fl_input_set_input_type(INPUT i, int t) {
+ static_cast<Fl_Input_*>(i)->input_type(t);
+}
+
+int fl_input_get_shortcut(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->shortcut();
+}
+
+void fl_input_set_shortcut(INPUT i, int t) {
+ static_cast<Fl_Input_*>(i)->shortcut(t);
+}
+
+int fl_input_get_mark(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->mark();
+}
+
+int fl_input_set_mark(INPUT i, int t) {
+ return static_cast<Fl_Input_*>(i)->mark(t);
+}
+
+int fl_input_get_position(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->position();
+}
+
+int fl_input_set_position(INPUT i, int t) {
+ return static_cast<Fl_Input_*>(i)->position(t);
+}
+
+int fl_input_set_position2(INPUT i, int p, int m) {
+ return static_cast<Fl_Input_*>(i)->position(p, m);
+}
+
+
+
+
+unsigned int fl_input_index(INPUT i, int p) {
+ return static_cast<Fl_Input_*>(i)->index(p);
+}
+
+int fl_input_insert(INPUT i, const char * s, int l) {
+ return static_cast<Fl_Input_*>(i)->insert(s,l);
+}
+
+int fl_input_replace(INPUT i, int b, int e, const char * s, int l) {
+ return static_cast<Fl_Input_*>(i)->replace(b,e,s,l);
+}
+
+const char * fl_input_get_value(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->value();
+}
+
+int fl_input_set_value(INPUT i, char * s, int len) {
+ return static_cast<Fl_Input_*>(i)->value(s,len);
+}
+
+
+
+
+int fl_input_get_maximum_size(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->maximum_size();
+}
+
+void fl_input_set_maximum_size(INPUT i, int t) {
+ static_cast<Fl_Input_*>(i)->maximum_size(t);
+}
+
+int fl_input_get_size(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->size();
+}
+
+
+
+
+unsigned int fl_input_get_cursor_color(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->cursor_color();
+}
+
+void fl_input_set_cursor_color(INPUT i, unsigned int t) {
+ static_cast<Fl_Input_*>(i)->cursor_color(t);
+}
+
+unsigned int fl_input_get_textcolor(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->textcolor();
+}
+
+void fl_input_set_textcolor(INPUT i, unsigned int t) {
+ static_cast<Fl_Input_*>(i)->textcolor(t);
+}
+
+int fl_input_get_textfont(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->textfont();
+}
+
+void fl_input_set_textfont(INPUT i, int t) {
+ static_cast<Fl_Input_*>(i)->textfont(t);
+}
+
+int fl_input_get_textsize(INPUT i) {
+ return static_cast<Fl_Input_*>(i)->textsize();
+}
+
+void fl_input_set_textsize(INPUT i, int t) {
+ static_cast<Fl_Input_*>(i)->textsize(t);
+}
+
+
+
+
+void fl_input_set_size(INPUT i, int w, int h) {
+ static_cast<Fl_Input_*>(i)->size(w,h);
+}
+
+void fl_input_resize(INPUT i, int x, int y, int w, int h) {
+ static_cast<Fl_Input_*>(i)->Fl_Input_::resize(x, y, w, h);
+}
+
+
+
+
+void fl_input_draw(INPUT i) {
+ // This inherits directly from Fl_Widget::draw, and
+ // the Fl_Widget draw method doesn't technically exist, so...
+ (void)(i);
+ // It is more convenient for this function to exist, however,
+ // even though it will likely never be called, because it simplifies
+ // and makes uniform the implementation of the Ada Input Draw subprogram.
+}
+
+int fl_input_handle(INPUT i, int e) {
+ return static_cast<My_Input*>(i)->Fl_Input_::handle(e);
+}
+
+
diff --git a/body/c_fl_input_.h b/body/c_fl_input_.h
new file mode 100644
index 0000000..689894e
--- /dev/null
+++ b/body/c_fl_input_.h
@@ -0,0 +1,77 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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" int fl_input_copy(INPUT i, int c);
+extern "C" int fl_input_cut(INPUT i);
+extern "C" int fl_input_cut2(INPUT i, int b);
+extern "C" int fl_input_cut3(INPUT i, int a, int b);
+extern "C" int fl_input_copy_cuts(INPUT i);
+extern "C" int fl_input_undo(INPUT i);
+
+
+extern "C" int fl_input_get_readonly(INPUT i);
+extern "C" void fl_input_set_readonly(INPUT i, int t);
+extern "C" int fl_input_get_tab_nav(INPUT i);
+extern "C" void fl_input_set_tab_nav(INPUT i, int t);
+extern "C" int fl_input_get_wrap(INPUT i);
+extern "C" void fl_input_set_wrap(INPUT i, int t);
+
+
+extern "C" int fl_input_get_input_type(INPUT i);
+extern "C" void fl_input_set_input_type(INPUT i, int t);
+extern "C" int fl_input_get_shortcut(INPUT i);
+extern "C" void fl_input_set_shortcut(INPUT i, int t);
+extern "C" int fl_input_get_mark(INPUT i);
+extern "C" int fl_input_set_mark(INPUT i, int t);
+extern "C" int fl_input_get_position(INPUT i);
+extern "C" int fl_input_set_position(INPUT i, int t);
+extern "C" int fl_input_set_position2(INPUT i, int p, int m);
+
+
+extern "C" unsigned int fl_input_index(INPUT i, int p);
+extern "C" int fl_input_insert(INPUT i, const char * s, int l);
+extern "C" int fl_input_replace(INPUT i, int b, int e, const char * s, int l);
+extern "C" const char * fl_input_get_value(INPUT i);
+extern "C" int fl_input_set_value(INPUT i, char * s, int len);
+
+
+extern "C" int fl_input_get_maximum_size(INPUT i);
+extern "C" void fl_input_set_maximum_size(INPUT i, int t);
+extern "C" int fl_input_get_size(INPUT i);
+
+
+extern "C" unsigned int fl_input_get_cursor_color(INPUT i);
+extern "C" void fl_input_set_cursor_color(INPUT i, unsigned int t);
+extern "C" unsigned int fl_input_get_textcolor(INPUT i);
+extern "C" void fl_input_set_textcolor(INPUT i, unsigned int t);
+extern "C" int fl_input_get_textfont(INPUT i);
+extern "C" void fl_input_set_textfont(INPUT i, int t);
+extern "C" int fl_input_get_textsize(INPUT i);
+extern "C" void fl_input_set_textsize(INPUT i, int t);
+
+
+extern "C" void fl_input_set_size(INPUT i, int w, int h);
+extern "C" void fl_input_resize(INPUT i, int x, int y, int w, int h);
+
+
+extern "C" void fl_input_draw(INPUT n);
+extern "C" int fl_input_handle(INPUT i, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_input_choice.cpp b/body/c_fl_input_choice.cpp
new file mode 100644
index 0000000..247e8eb
--- /dev/null
+++ b/body/c_fl_input_choice.cpp
@@ -0,0 +1,151 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Input_Choice.H>
+#include "c_fl_input_choice.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Input_Choice : public Fl_Input_Choice {
+public:
+ using Fl_Input_Choice::Fl_Input_Choice;
+
+ friend void fl_input_choice_draw(INPUTCHOICE n);
+ friend int fl_input_choice_handle(INPUTCHOICE n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Input_Choice::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Input_Choice::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+INPUTCHOICE new_fl_input_choice(int x, int y, int w, int h, char* label) {
+ My_Input_Choice *n = new My_Input_Choice(x, y, w, h, label);
+ return n;
+}
+
+void free_fl_input_choice(INPUTCHOICE n) {
+ delete static_cast<My_Input_Choice*>(n);
+}
+
+
+
+
+void * fl_input_choice_input(INPUTCHOICE n) {
+ return static_cast<Fl_Input_Choice*>(n)->input();
+}
+
+void * fl_input_choice_menubutton(INPUTCHOICE n) {
+ return static_cast<Fl_Input_Choice*>(n)->menubutton();
+}
+
+
+
+
+void fl_input_choice_clear(INPUTCHOICE n) {
+ static_cast<Fl_Input_Choice*>(n)->clear();
+}
+
+
+
+
+int fl_input_choice_changed(INPUTCHOICE n) {
+ return static_cast<Fl_Input_Choice*>(n)->changed();
+}
+
+void fl_input_choice_clear_changed(INPUTCHOICE n) {
+ static_cast<Fl_Input_Choice*>(n)->clear_changed();
+}
+
+void fl_input_choice_set_changed(INPUTCHOICE n) {
+ static_cast<Fl_Input_Choice*>(n)->set_changed();
+}
+
+int fl_input_choice_get_down_box(INPUTCHOICE n) {
+ return static_cast<Fl_Input_Choice*>(n)->down_box();
+}
+
+void fl_input_choice_set_down_box(INPUTCHOICE n, int t) {
+ static_cast<Fl_Input_Choice*>(n)->down_box(static_cast<Fl_Boxtype>(t));
+}
+
+unsigned int fl_input_choice_get_textcolor(INPUTCHOICE n) {
+ return static_cast<Fl_Input_Choice*>(n)->textcolor();
+}
+
+void fl_input_choice_set_textcolor(INPUTCHOICE n, unsigned int t) {
+ static_cast<Fl_Input_Choice*>(n)->textcolor(t);
+}
+
+int fl_input_choice_get_textfont(INPUTCHOICE n) {
+ return static_cast<Fl_Input_Choice*>(n)->textfont();
+}
+
+void fl_input_choice_set_textfont(INPUTCHOICE n, int t) {
+ static_cast<Fl_Input_Choice*>(n)->textfont(t);
+}
+
+int fl_input_choice_get_textsize(INPUTCHOICE n) {
+ return static_cast<Fl_Input_Choice*>(n)->textsize();
+}
+
+void fl_input_choice_set_textsize(INPUTCHOICE n, int t) {
+ static_cast<Fl_Input_Choice*>(n)->textsize(t);
+}
+
+const char * fl_input_choice_get_value(INPUTCHOICE n) {
+ return static_cast<Fl_Input_Choice*>(n)->value();
+}
+
+void fl_input_choice_set_value(INPUTCHOICE n, const char * t) {
+ static_cast<Fl_Input_Choice*>(n)->value(t);
+}
+
+void fl_input_choice_set_value2(INPUTCHOICE n, int t) {
+ static_cast<Fl_Input_Choice*>(n)->value(t);
+}
+
+
+
+
+void fl_input_choice_resize(INPUTCHOICE n, int x, int y, int w, int h) {
+ static_cast<Fl_Input_Choice*>(n)->resize(x, y, w, h);
+}
+
+
+
+
+void fl_input_choice_draw(INPUTCHOICE n) {
+ static_cast<My_Input_Choice*>(n)->Fl_Input_Choice::draw();
+}
+
+int fl_input_choice_handle(INPUTCHOICE n, int e) {
+ return static_cast<My_Input_Choice*>(n)->Fl_Input_Choice::handle(e);
+}
+
+
diff --git a/body/c_fl_input_choice.h b/body/c_fl_input_choice.h
new file mode 100644
index 0000000..a7ee0c3
--- /dev/null
+++ b/body/c_fl_input_choice.h
@@ -0,0 +1,50 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_INPUT_CHOICE_GUARD
+#define FL_INPUT_CHOICE_GUARD
+
+
+typedef void* INPUTCHOICE;
+
+
+extern "C" INPUTCHOICE new_fl_input_choice(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_input_choice(INPUTCHOICE n);
+
+
+extern "C" void * fl_input_choice_input(INPUTCHOICE n);
+extern "C" void * fl_input_choice_menubutton(INPUTCHOICE n);
+
+
+extern "C" void fl_input_choice_clear(INPUTCHOICE n);
+
+
+extern "C" int fl_input_choice_changed(INPUTCHOICE n);
+extern "C" void fl_input_choice_clear_changed(INPUTCHOICE n);
+extern "C" void fl_input_choice_set_changed(INPUTCHOICE n);
+extern "C" int fl_input_choice_get_down_box(INPUTCHOICE n);
+extern "C" void fl_input_choice_set_down_box(INPUTCHOICE n, int t);
+extern "C" unsigned int fl_input_choice_get_textcolor(INPUTCHOICE n);
+extern "C" void fl_input_choice_set_textcolor(INPUTCHOICE n, unsigned int t);
+extern "C" int fl_input_choice_get_textfont(INPUTCHOICE n);
+extern "C" void fl_input_choice_set_textfont(INPUTCHOICE n, int t);
+extern "C" int fl_input_choice_get_textsize(INPUTCHOICE n);
+extern "C" void fl_input_choice_set_textsize(INPUTCHOICE n, int t);
+extern "C" const char * fl_input_choice_get_value(INPUTCHOICE n);
+extern "C" void fl_input_choice_set_value(INPUTCHOICE n, const char * t);
+extern "C" void fl_input_choice_set_value2(INPUTCHOICE n, int t);
+
+
+extern "C" void fl_input_choice_resize(INPUTCHOICE n, int x, int y, int w, int h);
+
+
+extern "C" void fl_input_choice_draw(INPUTCHOICE n);
+extern "C" int fl_input_choice_handle(INPUTCHOICE n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_int_input.cpp b/body/c_fl_int_input.cpp
new file mode 100644
index 0000000..8f780d7
--- /dev/null
+++ b/body/c_fl_int_input.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Int_Input.H>
+#include "c_fl_int_input.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Int_Input : public Fl_Int_Input {
+public:
+ using Fl_Int_Input::Fl_Int_Input;
+
+ friend void fl_int_input_draw(INTINPUT i);
+ friend int fl_int_input_handle(INTINPUT i, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Int_Input::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Int_Input::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+INTINPUT new_fl_int_input(int x, int y, int w, int h, char* label) {
+ My_Int_Input *i = new My_Int_Input(x, y, w, h, label);
+ return i;
+}
+
+void free_fl_int_input(INTINPUT i) {
+ delete static_cast<My_Int_Input*>(i);
+}
+
+
+
+
+void fl_int_input_draw(INTINPUT i) {
+ static_cast<My_Int_Input*>(i)->Fl_Int_Input::draw();
+}
+
+int fl_int_input_handle(INTINPUT i, int e) {
+ return static_cast<My_Int_Input*>(i)->Fl_Int_Input::handle(e);
+}
+
+
diff --git a/body/c_fl_int_input.h b/body/c_fl_int_input.h
new file mode 100644
index 0000000..e36cfaa
--- /dev/null
+++ b/body/c_fl_int_input.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_INT_INPUT_GUARD
+#define FL_INT_INPUT_GUARD
+
+
+typedef void* INTINPUT;
+
+
+extern "C" INTINPUT new_fl_int_input(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_int_input(INTINPUT i);
+
+
+extern "C" void fl_int_input_draw(INTINPUT i);
+extern "C" int fl_int_input_handle(INTINPUT i, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_jpeg_image.cpp b/body/c_fl_jpeg_image.cpp
new file mode 100644
index 0000000..63cbe8d
--- /dev/null
+++ b/body/c_fl_jpeg_image.cpp
@@ -0,0 +1,26 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_JPEG_Image.H>
+#include "c_fl_jpeg_image.h"
+
+
+
+
+JPEGIMAGE new_fl_jpeg_image(const char * f) {
+ Fl_JPEG_Image *j = new Fl_JPEG_Image(f);
+ return j;
+}
+
+JPEGIMAGE new_fl_jpeg_image2(const char *n, void *data) {
+ Fl_JPEG_Image *j = new Fl_JPEG_Image(n, static_cast<uchar*>(data));
+ return j;
+}
+
+void free_fl_jpeg_image(JPEGIMAGE j) {
+ delete static_cast<Fl_JPEG_Image*>(j);
+}
+
diff --git a/body/c_fl_jpeg_image.h b/body/c_fl_jpeg_image.h
new file mode 100644
index 0000000..013ae37
--- /dev/null
+++ b/body/c_fl_jpeg_image.h
@@ -0,0 +1,21 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_JPEG_IMAGE_GUARD
+#define FL_JPEG_IMAGE_GUARD
+
+
+typedef void* JPEGIMAGE;
+
+
+extern "C" JPEGIMAGE new_fl_jpeg_image(const char * f);
+extern "C" JPEGIMAGE new_fl_jpeg_image2(const char * n, void *data);
+extern "C" void free_fl_jpeg_image(JPEGIMAGE j);
+
+
+#endif
+
+
diff --git a/body/c_fl_label.cpp b/body/c_fl_label.cpp
new file mode 100644
index 0000000..2200c51
--- /dev/null
+++ b/body/c_fl_label.cpp
@@ -0,0 +1,95 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Widget.H>
+#include <FL/Fl_Image.H>
+#include "c_fl_label.h"
+
+
+
+
+LABEL new_fl_label(const char * v, int f, int s, unsigned int h, int k, unsigned int p) {
+ Fl_Label *l = new Fl_Label;
+ l->value = v;
+ l->font = f;
+ l->size = s;
+ l->color = h;
+ l->align_ = p;
+ l->type = (uchar)k;
+ return l;
+}
+
+void free_fl_label(LABEL l) {
+ delete static_cast<Fl_Label*>(l);
+}
+
+
+
+
+void fl_label_set_value(LABEL l, const char * v) {
+ static_cast<Fl_Label*>(l)->value = v;
+}
+
+int fl_label_get_font(LABEL l) {
+ return static_cast<Fl_Label*>(l)->font;
+}
+
+void fl_label_set_font(LABEL l, int f) {
+ static_cast<Fl_Label*>(l)->font = f;
+}
+
+int fl_label_get_size(LABEL l) {
+ return static_cast<Fl_Label*>(l)->size;
+}
+
+void fl_label_set_size(LABEL l, int s) {
+ static_cast<Fl_Label*>(l)->size = s;
+}
+
+unsigned int fl_label_get_color(LABEL l) {
+ return static_cast<Fl_Label*>(l)->color;
+}
+
+void fl_label_set_color(LABEL l, unsigned int h) {
+ static_cast<Fl_Label*>(l)->color = h;
+}
+
+int fl_label_get_type(LABEL l) {
+ return (int)static_cast<Fl_Label*>(l)->type;
+}
+
+void fl_label_set_type(LABEL l, int k) {
+ static_cast<Fl_Label*>(l)->type = (uchar)k;
+}
+
+unsigned int fl_label_get_align(LABEL l) {
+ return static_cast<Fl_Label*>(l)->align_;
+}
+
+void fl_label_set_align(LABEL l, unsigned int p) {
+ static_cast<Fl_Label*>(l)->align_ = p;
+}
+
+void fl_label_set_image(LABEL l, void * i) {
+ static_cast<Fl_Label*>(l)->image = static_cast<Fl_Image*>(i);
+}
+
+void fl_label_set_deimage(LABEL l, void * i) {
+ static_cast<Fl_Label*>(l)->deimage = static_cast<Fl_Image*>(i);
+}
+
+
+
+
+void fl_label_draw(LABEL l, int x, int y, int w, int h, unsigned int p) {
+ static_cast<Fl_Label*>(l)->draw(x, y, w, h, p);
+}
+
+void fl_label_measure(LABEL l, int &w, int &h) {
+ static_cast<Fl_Label*>(l)->measure(w, h);
+}
+
+
diff --git a/body/c_fl_label.h b/body/c_fl_label.h
new file mode 100644
index 0000000..806aa72
--- /dev/null
+++ b/body/c_fl_label.h
@@ -0,0 +1,39 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_LABEL_GUARD
+#define FL_LABEL_GUARD
+
+
+typedef void* LABEL;
+
+
+extern "C" LABEL new_fl_label(const char * v, int f, int s, unsigned int h, int k, unsigned int p);
+extern "C" void free_fl_label(LABEL l);
+
+
+extern "C" void fl_label_set_value(LABEL l, const char * v);
+extern "C" int fl_label_get_font(LABEL l);
+extern "C" void fl_label_set_font(LABEL l, int f);
+extern "C" int fl_label_get_size(LABEL l);
+extern "C" void fl_label_set_size(LABEL l, int s);
+extern "C" unsigned int fl_label_get_color(LABEL l);
+extern "C" void fl_label_set_color(LABEL l, unsigned int h);
+extern "C" int fl_label_get_type(LABEL l);
+extern "C" void fl_label_set_type(LABEL l, int k);
+extern "C" unsigned int fl_label_get_align(LABEL l);
+extern "C" void fl_label_set_align(LABEL l, unsigned int p);
+extern "C" void fl_label_set_image(LABEL l, void * i);
+extern "C" void fl_label_set_deimage(LABEL l, void * i);
+
+
+extern "C" void fl_label_draw(LABEL l, int x, int y, int w, int h, unsigned int p);
+extern "C" void fl_label_measure(LABEL l, int &w, int &h);
+
+
+#endif
+
+
diff --git a/body/c_fl_light_button.cpp b/body/c_fl_light_button.cpp
new file mode 100644
index 0000000..e11ce64
--- /dev/null
+++ b/body/c_fl_light_button.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Light_Button.H>
+#include "c_fl_light_button.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Light_Button : public Fl_Light_Button {
+public:
+ using Fl_Light_Button::Fl_Light_Button;
+
+ friend void fl_light_button_draw(LIGHTBUTTON b);
+ friend int fl_light_button_handle(LIGHTBUTTON b, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Light_Button::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Light_Button::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+LIGHTBUTTON new_fl_light_button(int x, int y, int w, int h, char* label) {
+ My_Light_Button *b = new My_Light_Button(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_light_button(LIGHTBUTTON b) {
+ delete static_cast<My_Light_Button*>(b);
+}
+
+
+
+
+void fl_light_button_draw(LIGHTBUTTON b) {
+ static_cast<My_Light_Button*>(b)->Fl_Light_Button::draw();
+}
+
+int fl_light_button_handle(LIGHTBUTTON b, int e) {
+ return static_cast<My_Light_Button*>(b)->Fl_Light_Button::handle(e);
+}
+
+
diff --git a/body/c_fl_light_button.h b/body/c_fl_light_button.h
new file mode 100644
index 0000000..5d604d2
--- /dev/null
+++ b/body/c_fl_light_button.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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);
+
+
+extern "C" void fl_light_button_draw(LIGHTBUTTON b);
+extern "C" int fl_light_button_handle(LIGHTBUTTON b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_line_dial.cpp b/body/c_fl_line_dial.cpp
new file mode 100644
index 0000000..388264f
--- /dev/null
+++ b/body/c_fl_line_dial.cpp
@@ -0,0 +1,74 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Line_Dial.H>
+#include "c_fl_line_dial.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Line_Dial : public Fl_Line_Dial {
+public:
+ using Fl_Line_Dial::Fl_Line_Dial;
+
+ friend void fl_line_dial_draw(LINEDIAL v);
+ friend int fl_line_dial_handle(LINEDIAL v, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Line_Dial::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Line_Dial::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Line_Dial::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+LINEDIAL new_fl_line_dial(int x, int y, int w, int h, char* label) {
+ My_Line_Dial *v = new My_Line_Dial(x, y, w, h, label);
+ return v;
+}
+
+void free_fl_line_dial(LINEDIAL v) {
+ delete static_cast<My_Line_Dial*>(v);
+}
+
+
+
+
+void fl_line_dial_draw(LINEDIAL v) {
+ static_cast<My_Line_Dial*>(v)->Fl_Line_Dial::draw();
+}
+
+int fl_line_dial_handle(LINEDIAL v, int e) {
+ return static_cast<My_Line_Dial*>(v)->Fl_Line_Dial::handle(e);
+}
+
+
diff --git a/body/c_fl_line_dial.h b/body/c_fl_line_dial.h
new file mode 100644
index 0000000..f7b49ca
--- /dev/null
+++ b/body/c_fl_line_dial.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_LINE_DIAL_GUARD
+#define FL_LINE_DIAL_GUARD
+
+
+typedef void* LINEDIAL;
+
+
+extern "C" LINEDIAL new_fl_line_dial(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_line_dial(LINEDIAL v);
+
+
+extern "C" void fl_line_dial_draw(LINEDIAL v);
+extern "C" int fl_line_dial_handle(LINEDIAL v, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_menu.cpp b/body/c_fl_menu.cpp
new file mode 100644
index 0000000..e42e985
--- /dev/null
+++ b/body/c_fl_menu.cpp
@@ -0,0 +1,300 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Menu_.H>
+#include <FL/Fl_Menu_Item.H>
+#include "c_fl_menu.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" void menu_item_callback_hook(void * cobj, void * ud);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Menu : public Fl_Menu_ {
+public:
+ using Fl_Menu_::Fl_Menu_;
+
+ friend void fl_menu_draw(MENU m);
+ friend int fl_menu_handle(MENU m, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Menu::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Menu::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+MENU new_fl_menu(int x, int y, int w, int h, char* label) {
+ My_Menu *m = new My_Menu(x, y, w, h, label);
+ return m;
+}
+
+void free_fl_menu(MENU m) {
+ delete static_cast<My_Menu*>(m);
+}
+
+
+
+
+int fl_menu_add(MENU m, const char * t) {
+ return static_cast<Fl_Menu_*>(m)->add(t);
+}
+
+int fl_menu_add2(MENU m, const char * t, unsigned long s, void * u, unsigned long f) {
+ return static_cast<Fl_Menu_*>(m)->add(t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+int fl_menu_add3(MENU m, const char * t, const char * s, void * u, unsigned long f) {
+ return static_cast<Fl_Menu_*>(m)->add(t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+int fl_menu_insert(MENU m, int p, const char * t, unsigned long s, void * u, unsigned long f) {
+ return static_cast<Fl_Menu_*>(m)->insert(p, t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+int fl_menu_insert2(MENU m, int p, const char * t, const char * s, void * u, unsigned long f) {
+ return static_cast<Fl_Menu_*>(m)->insert(p, t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+void fl_menu_copy(MENU m, void * mi) {
+ static_cast<Fl_Menu_*>(m)->copy(static_cast<const Fl_Menu_Item*>(mi), 0);
+}
+
+void fl_menu_set_menu(MENU m, MENU d) {
+ static_cast<Fl_Menu_*>(m)->menu(static_cast<Fl_Menu_*>(d)->menu());
+}
+
+void fl_menu_remove(MENU m, int p) {
+ static_cast<Fl_Menu_*>(m)->remove(p);
+}
+
+void fl_menu_clear(MENU m) {
+ static_cast<Fl_Menu_*>(m)->clear();
+}
+
+int fl_menu_clear_submenu(MENU m, int i) {
+ return static_cast<Fl_Menu_*>(m)->clear_submenu(i);
+}
+
+
+
+
+const void * fl_menu_get_item(MENU m, int i) {
+ return &(static_cast<Fl_Menu_*>(m)->menu()[i]);
+}
+
+// find_item and find_item2 are subsumed by find_index and find_index3
+// since we need to get the index for the Ada side anyway.
+
+int fl_menu_find_index(MENU m, const char * t) {
+ return static_cast<Fl_Menu_*>(m)->find_index(t);
+}
+
+int fl_menu_find_index2(MENU m, void * i) {
+ return static_cast<Fl_Menu_*>(m)->find_index(static_cast<Fl_Menu_Item*>(i));
+}
+
+int fl_menu_find_index3(MENU m, void * cb) {
+ // have to loop through the array manually since callbacks are stored in userdata
+ for (int i=0; i<fl_menu_size(m); i++) {
+ if (static_cast<Fl_Menu_*>(m)->menu()[i].user_data() == cb) {
+ return i;
+ }
+ }
+ return -1;
+}
+
+int fl_menu_item_pathname(MENU m, char * buf, int len, void * mi) {
+ return static_cast<Fl_Menu_*>(m)->item_pathname(buf, len, static_cast<Fl_Menu_Item*>(mi));
+}
+
+int fl_menu_size(MENU m) {
+ return static_cast<Fl_Menu_*>(m)->size();
+}
+
+
+
+
+// mvalue is subsumed by value since we need to get the index for
+// the Ada side anyway.
+
+const char * fl_menu_text(MENU m) {
+ return static_cast<Fl_Menu_*>(m)->text();
+}
+
+int fl_menu_value(MENU m) {
+ return static_cast<Fl_Menu_*>(m)->value();
+}
+
+int fl_menu_set_value(MENU m, void * i) {
+ return static_cast<Fl_Menu_*>(m)->value(static_cast<Fl_Menu_Item*>(i));
+}
+
+int fl_menu_set_value2(MENU m, int p) {
+ return static_cast<Fl_Menu_*>(m)->value(p);
+}
+
+
+
+
+void fl_menu_setonly(MENU m, void * mi) {
+ static_cast<Fl_Menu_*>(m)->setonly(static_cast<Fl_Menu_Item*>(mi));
+}
+
+const char * fl_menu_text2(MENU m, int i) {
+ return static_cast<Fl_Menu_*>(m)->text(i);
+}
+
+void fl_menu_replace(MENU m, int i, const char * t) {
+ static_cast<Fl_Menu_*>(m)->replace(i, t);
+}
+
+void fl_menu_shortcut(MENU m, int i, unsigned long s) {
+ static_cast<Fl_Menu_*>(m)->shortcut(i, s);
+}
+
+unsigned long fl_menu_get_mode(MENU m, int i) {
+ return static_cast<Fl_Menu_*>(m)->mode(i);
+}
+
+void fl_menu_set_mode(MENU m, int i, unsigned long f) {
+ static_cast<Fl_Menu_*>(m)->mode(i, f);
+}
+
+
+
+
+unsigned int fl_menu_get_textcolor(MENU m) {
+ return static_cast<Fl_Menu_*>(m)->textcolor();
+}
+
+void fl_menu_set_textcolor(MENU m, unsigned int c) {
+ static_cast<Fl_Menu_*>(m)->textcolor(c);
+}
+
+int fl_menu_get_textfont(MENU m) {
+ return static_cast<Fl_Menu_*>(m)->textfont();
+}
+
+void fl_menu_set_textfont(MENU m, int f) {
+ static_cast<Fl_Menu_*>(m)->textfont(f);
+}
+
+int fl_menu_get_textsize(MENU m) {
+ return static_cast<Fl_Menu_*>(m)->textsize();
+}
+
+void fl_menu_set_textsize(MENU m, int s) {
+ static_cast<Fl_Menu_*>(m)->textsize(s);
+}
+
+
+
+
+int fl_menu_get_down_box(MENU m) {
+ return static_cast<Fl_Menu_*>(m)->down_box();
+}
+
+void fl_menu_set_down_box(MENU m, int t) {
+ static_cast<Fl_Menu_*>(m)->down_box(static_cast<Fl_Boxtype>(t));
+}
+
+void fl_menu_global(MENU m) {
+ static_cast<Fl_Menu_*>(m)->global();
+}
+
+int fl_menu_measure(MENU m, int i, int *h) {
+ // method actually belongs to Fl_Menu_Item
+ const Fl_Menu_Item * item = static_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,i));
+ return item==0?0:item->measure(h, static_cast<Fl_Menu_*>(m));
+}
+
+
+
+
+const void * fl_menu_popup(MENU m, int x, int y, const char * t, int n) {
+ // method actually belongs to Fl_Menu_Item
+ const Fl_Menu_Item * menuhead = static_cast<const Fl_Menu_Item*>(fl_menu_get_item(m, 0));
+ const Fl_Menu_Item * initial = n<0?0:static_cast<const Fl_Menu_Item*>(fl_menu_get_item(m, n));
+ return menuhead->popup(x, y, t, initial, static_cast<Fl_Menu_*>(m));
+}
+
+const void * fl_menu_pulldown(MENU m, int x, int y, int w, int h, int n) {
+ // method actually belongs to Fl_Menu_Item
+ const Fl_Menu_Item * menuhead = static_cast<const Fl_Menu_Item*>(fl_menu_get_item(m, 0));
+ const Fl_Menu_Item * initial = n<0?0:static_cast<const Fl_Menu_Item*>(fl_menu_get_item(m, n));
+ return menuhead->pulldown(x, y, w, h, initial, static_cast<Fl_Menu_*>(m));
+}
+
+const void * fl_menu_picked(MENU m, const void * mi) {
+ return static_cast<Fl_Menu_*>(m)->picked(static_cast<const Fl_Menu_Item*>(mi));
+}
+
+const void * fl_menu_find_shortcut(MENU m, void * ip, int a) {
+ // method actually belongs to Fl_Menu_Item
+ const Fl_Menu_Item * dummy = static_cast<const Fl_Menu_Item*>(fl_menu_get_item(m, 0));
+ return dummy==0?0:dummy->find_shortcut(static_cast<int*>(ip), static_cast<bool>(a));
+}
+
+const void * fl_menu_test_shortcut(MENU m) {
+ return static_cast<Fl_Menu_*>(m)->test_shortcut();
+}
+
+
+
+
+void fl_menu_size2(MENU m, int w, int h) {
+ static_cast<Fl_Menu_*>(m)->size(w, h);
+}
+
+
+
+
+void fl_menu_draw_item(MENU m, int i, int x, int y, int w, int h, int s) {
+ // method actually belongs to Fl_Menu_Item
+ const Fl_Menu_Item * item = static_cast<const Fl_Menu_Item*>(fl_menu_get_item(m,i));
+ if (item != 0) {
+ item->draw(x, y, w, h, static_cast<Fl_Menu_*>(m), s);
+ }
+}
+
+void fl_menu_draw(MENU m) {
+ // The Fl_Menu_ draw method doesn't technically exist, so...
+ (void)(m);
+ // It is more convenient for this function to exist, however,
+ // even though it will likely never be called, because it simplifies
+ // and makes uniform the implementation of the Ada Menu Draw subprogram.
+}
+
+int fl_menu_handle(MENU m, int e) {
+ return static_cast<My_Menu*>(m)->Fl_Menu_::handle(e);
+}
+
+
diff --git a/body/c_fl_menu.h b/body/c_fl_menu.h
new file mode 100644
index 0000000..17ae326
--- /dev/null
+++ b/body/c_fl_menu.h
@@ -0,0 +1,87 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_MENU_GUARD
+#define FL_MENU_GUARD
+
+
+typedef void* MENU;
+
+
+extern "C" MENU new_fl_menu(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_menu(MENU m);
+
+
+extern "C" int fl_menu_add(MENU m, const char * t);
+extern "C" int fl_menu_add2(MENU m, const char * t, unsigned long s, void * u, unsigned long f);
+extern "C" int fl_menu_add3(MENU m, const char * t, const char * s, void * u, unsigned long f);
+extern "C" int fl_menu_insert(MENU m, int p, const char * t,
+ unsigned long s, void * u, unsigned long f);
+extern "C" int fl_menu_insert2(MENU m, int p, const char * t,
+ const char * s, void * u, unsigned long f);
+extern "C" void fl_menu_copy(MENU m, void * mi);
+extern "C" void fl_menu_set_menu(MENU m, MENU d);
+extern "C" void fl_menu_remove(MENU m, int p);
+extern "C" void fl_menu_clear(MENU m);
+extern "C" int fl_menu_clear_submenu(MENU m, int i);
+
+
+extern "C" const void * fl_menu_get_item(MENU m, int i);
+// find_item and find_item2 are subsumed by find_index and find_index3
+extern "C" int fl_menu_find_index(MENU m, const char * t);
+extern "C" int fl_menu_find_index2(MENU m, void * i);
+extern "C" int fl_menu_find_index3(MENU m, void * cb);
+extern "C" int fl_menu_item_pathname(MENU m, char * buf, int len, void * mi);
+extern "C" int fl_menu_size(MENU m);
+
+
+// mvalue is subsumed by value
+extern "C" const char * fl_menu_text(MENU m);
+extern "C" int fl_menu_value(MENU m);
+extern "C" int fl_menu_set_value(MENU m, void * i);
+extern "C" int fl_menu_set_value2(MENU m, int p);
+
+
+extern "C" void fl_menu_setonly(MENU m, void * mi);
+extern "C" const char * fl_menu_text2(MENU m, int i);
+extern "C" void fl_menu_replace(MENU m, int i, const char * t);
+extern "C" void fl_menu_shortcut(MENU m, int i, unsigned long s);
+extern "C" unsigned long fl_menu_get_mode(MENU m, int i);
+extern "C" void fl_menu_set_mode(MENU m, int i, unsigned long f);
+
+
+extern "C" unsigned int fl_menu_get_textcolor(MENU m);
+extern "C" void fl_menu_set_textcolor(MENU m, unsigned int c);
+extern "C" int fl_menu_get_textfont(MENU m);
+extern "C" void fl_menu_set_textfont(MENU m, int f);
+extern "C" int fl_menu_get_textsize(MENU m);
+extern "C" void fl_menu_set_textsize(MENU m, int s);
+
+
+extern "C" int fl_menu_get_down_box(MENU m);
+extern "C" void fl_menu_set_down_box(MENU m, int t);
+extern "C" void fl_menu_global(MENU m);
+extern "C" int fl_menu_measure(MENU m, int i, int *h);
+
+
+extern "C" const void * fl_menu_popup(MENU m, int x, int y, const char * t, int n);
+extern "C" const void * fl_menu_pulldown(MENU m, int x, int y, int w, int h, int n);
+extern "C" const void * fl_menu_picked(MENU m, const void * mi);
+extern "C" const void * fl_menu_find_shortcut(MENU m, void * ip, int a);
+extern "C" const void * fl_menu_test_shortcut(MENU m);
+
+
+extern "C" void fl_menu_size2(MENU m, int w, int h);
+
+
+extern "C" void fl_menu_draw_item(MENU m, int i, int x, int y, int w, int h, int s);
+extern "C" void fl_menu_draw(MENU m);
+extern "C" int fl_menu_handle(MENU m, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_menu_bar.cpp b/body/c_fl_menu_bar.cpp
new file mode 100644
index 0000000..5e73675
--- /dev/null
+++ b/body/c_fl_menu_bar.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Menu_Bar.H>
+#include "c_fl_menu_bar.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Menu_Bar : public Fl_Menu_Bar {
+public:
+ using Fl_Menu_Bar::Fl_Menu_Bar;
+
+ friend void fl_menu_bar_draw(MENUBAR m);
+ friend int fl_menu_bar_handle(MENUBAR m, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Menu_Bar::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Menu_Bar::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label) {
+ My_Menu_Bar *m = new My_Menu_Bar(x, y, w, h, label);
+ return m;
+}
+
+void free_fl_menu_bar(MENUBAR m) {
+ delete static_cast<My_Menu_Bar*>(m);
+}
+
+
+
+
+void fl_menu_bar_draw(MENUBAR m) {
+ static_cast<My_Menu_Bar*>(m)->Fl_Menu_Bar::draw();
+}
+
+int fl_menu_bar_handle(MENUBAR m, int e) {
+ return static_cast<My_Menu_Bar*>(m)->Fl_Menu_Bar::handle(e);
+}
+
+
diff --git a/body/c_fl_menu_bar.h b/body/c_fl_menu_bar.h
new file mode 100644
index 0000000..ae99467
--- /dev/null
+++ b/body/c_fl_menu_bar.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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);
+
+
+extern "C" void fl_menu_bar_draw(MENUBAR m);
+extern "C" int fl_menu_bar_handle(MENUBAR m, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_menu_button.cpp b/body/c_fl_menu_button.cpp
new file mode 100644
index 0000000..abe9712
--- /dev/null
+++ b/body/c_fl_menu_button.cpp
@@ -0,0 +1,90 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Menu_Button.H>
+#include "c_fl_menu_button.h"
+
+
+
+
+// Telprot stopovers
+
+extern "C" void menu_button_extra_init_hook
+ (void * aobj, int x, int y, int w, int h, const char * l);
+void fl_menu_button_extra_init(void * adaobj, int x, int y, int w, int h, const char * label) {
+ menu_button_extra_init_hook(adaobj, x, y, w, h, label);
+}
+
+extern "C" void menu_button_extra_final_hook(void * aobj);
+void fl_menu_button_extra_final(void * adaobj) {
+ menu_button_extra_final_hook(adaobj);
+}
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Menu_Button : public Fl_Menu_Button {
+public:
+ using Fl_Menu_Button::Fl_Menu_Button;
+
+ friend void fl_menu_button_draw(MENUBUTTON m);
+ friend int fl_menu_button_handle(MENUBUTTON m, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Menu_Button::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Menu_Button::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label) {
+ My_Menu_Button *m = new My_Menu_Button(x, y, w, h, label);
+ return m;
+}
+
+void free_fl_menu_button(MENUBUTTON m) {
+ delete static_cast<My_Menu_Button*>(m);
+}
+
+
+
+
+const void * fl_menu_button_popup(MENUBUTTON m) {
+ return static_cast<Fl_Menu_Button*>(m)->popup();
+}
+
+
+
+
+void fl_menu_button_draw(MENUBUTTON m) {
+ static_cast<My_Menu_Button*>(m)->Fl_Menu_Button::draw();
+}
+
+int fl_menu_button_handle(MENUBUTTON m, int e) {
+ return static_cast<My_Menu_Button*>(m)->Fl_Menu_Button::handle(e);
+}
+
+
diff --git a/body/c_fl_menu_button.h b/body/c_fl_menu_button.h
new file mode 100644
index 0000000..d567e4f
--- /dev/null
+++ b/body/c_fl_menu_button.h
@@ -0,0 +1,32 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_MENU_BUTTON_GUARD
+#define FL_MENU_BUTTON_GUARD
+
+
+extern "C" void fl_menu_button_extra_init
+ (void * adaobj, int x, int y, int w, int h, const char * label);
+extern "C" void fl_menu_button_extra_final(void * adaobj);
+
+
+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" const void * fl_menu_button_popup(MENUBUTTON m);
+
+
+extern "C" void fl_menu_button_draw(MENUBUTTON m);
+extern "C" int fl_menu_button_handle(MENUBUTTON m, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_menu_window.cpp b/body/c_fl_menu_window.cpp
new file mode 100644
index 0000000..cae1bf9
--- /dev/null
+++ b/body/c_fl_menu_window.cpp
@@ -0,0 +1,106 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Menu_Window.H>
+#include "c_fl_menu_window.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Menu_Window : public Fl_Menu_Window {
+public:
+ using Fl_Menu_Window::Fl_Menu_Window;
+
+ friend void fl_menu_window_draw(MENUWINDOW n);
+ friend int fl_menu_window_handle(MENUWINDOW n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Menu_Window::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Menu_Window::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label) {
+ My_Menu_Window *m = new My_Menu_Window(x, y, w, h, label);
+ return m;
+}
+
+MENUWINDOW new_fl_menu_window2(int w, int h, char* label) {
+ My_Menu_Window *m = new My_Menu_Window(w, h, label);
+ return m;
+}
+
+void free_fl_menu_window(MENUWINDOW m) {
+ delete static_cast<My_Menu_Window*>(m);
+}
+
+
+
+
+void fl_menu_window_show(MENUWINDOW m) {
+ static_cast<Fl_Menu_Window*>(m)->show();
+}
+
+void fl_menu_window_hide(MENUWINDOW m) {
+ static_cast<Fl_Menu_Window*>(m)->hide();
+}
+
+void fl_menu_window_flush(MENUWINDOW m) {
+ static_cast<Fl_Menu_Window*>(m)->flush();
+}
+
+void fl_menu_window_erase(MENUWINDOW m) {
+ static_cast<Fl_Menu_Window*>(m)->erase();
+}
+
+
+
+
+void fl_menu_window_set_overlay(MENUWINDOW m) {
+ static_cast<Fl_Menu_Window*>(m)->set_overlay();
+}
+
+void fl_menu_window_clear_overlay(MENUWINDOW m) {
+ static_cast<Fl_Menu_Window*>(m)->clear_overlay();
+}
+
+unsigned int fl_menu_window_overlay(MENUWINDOW m) {
+ return static_cast<Fl_Menu_Window*>(m)->overlay();
+}
+
+
+
+
+void fl_menu_window_draw(MENUWINDOW n) {
+ static_cast<My_Menu_Window*>(n)->Fl_Menu_Window::draw();
+}
+
+int fl_menu_window_handle(MENUWINDOW n, int e) {
+ return static_cast<My_Menu_Window*>(n)->Fl_Menu_Window::handle(e);
+}
+
+
diff --git a/body/c_fl_menu_window.h b/body/c_fl_menu_window.h
new file mode 100644
index 0000000..020a377
--- /dev/null
+++ b/body/c_fl_menu_window.h
@@ -0,0 +1,36 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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, char* label);
+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_erase(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);
+
+
+extern "C" void fl_menu_window_draw(MENUWINDOW n);
+extern "C" int fl_menu_window_handle(MENUWINDOW n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_menuitem.cpp b/body/c_fl_menuitem.cpp
new file mode 100644
index 0000000..b72c065
--- /dev/null
+++ b/body/c_fl_menuitem.cpp
@@ -0,0 +1,194 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Menu_Item.H>
+#include <FL/Fl_Widget.H>
+#include <FL/Fl_Image.H>
+#include "c_fl_menuitem.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void menu_item_callback_hook(void * cobj, void * ud);
+
+
+
+
+// Flattened C API
+
+void * null_fl_menu_item() {
+ Fl_Menu_Item *mi = new Fl_Menu_Item;
+ mi->label(0);
+ return mi;
+}
+
+void * new_fl_menu_item(char * t, void * c, int s, int f) {
+ Fl_Menu_Item *mi = new Fl_Menu_Item;
+ mi->callback(c==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), c);
+ mi->flags = static_cast<int>(f);
+ mi->shortcut(static_cast<int>(s));
+ mi->label(t);
+ return mi;
+}
+
+void free_fl_menu_item(MENUITEM mi) {
+ delete static_cast<Fl_Menu_Item*>(mi);
+}
+
+
+
+
+void * fl_menu_item_get_user_data(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->user_data();
+}
+
+void fl_menu_item_set_callback(MENUITEM mi, void * c) {
+ static_cast<Fl_Menu_Item*>(mi)->callback
+ (c==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), c);
+}
+
+void fl_menu_item_do_callback(MENUITEM mi, void * w) {
+ static_cast<Fl_Menu_Item*>(mi)->do_callback(static_cast<Fl_Widget*>(w));
+}
+
+
+
+
+int fl_menu_item_checkbox(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->checkbox();
+}
+
+int fl_menu_item_radio(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->radio();
+}
+
+int fl_menu_item_submenu(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->submenu();
+}
+
+int fl_menu_item_value(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->value();
+}
+
+void fl_menu_item_set(MENUITEM mi) {
+ static_cast<Fl_Menu_Item*>(mi)->set();
+}
+
+void fl_menu_item_clear(MENUITEM mi) {
+ static_cast<Fl_Menu_Item*>(mi)->clear();
+}
+
+void fl_menu_item_setonly(MENUITEM mi) {
+ static_cast<Fl_Menu_Item*>(mi)->setonly();
+}
+
+
+
+
+const char * fl_menu_item_get_label(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->label();
+}
+
+void fl_menu_item_set_label(MENUITEM mi, const char *t) {
+ static_cast<Fl_Menu_Item*>(mi)->label(t);
+}
+
+void fl_menu_item_set_label2(MENUITEM mi, int k, const char * t) {
+ static_cast<Fl_Menu_Item*>(mi)->label(static_cast<Fl_Labeltype>(k), t);
+}
+
+unsigned int fl_menu_item_get_labelcolor(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->labelcolor();
+}
+
+void fl_menu_item_set_labelcolor(MENUITEM mi, unsigned int c) {
+ static_cast<Fl_Menu_Item*>(mi)->labelcolor(c);
+}
+
+int fl_menu_item_get_labelfont(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->labelfont();
+}
+
+void fl_menu_item_set_labelfont(MENUITEM mi, int f) {
+ static_cast<Fl_Menu_Item*>(mi)->labelfont(f);
+}
+
+int fl_menu_item_get_labelsize(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->labelsize();
+}
+
+void fl_menu_item_set_labelsize(MENUITEM mi, int s) {
+ static_cast<Fl_Menu_Item*>(mi)->labelsize(s);
+}
+
+int fl_menu_item_get_labeltype(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->labeltype();
+}
+
+void fl_menu_item_set_labeltype(MENUITEM mi, int t) {
+ static_cast<Fl_Menu_Item*>(mi)->labeltype(static_cast<Fl_Labeltype>(t));
+}
+
+
+
+
+int fl_menu_item_get_shortcut(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->shortcut();
+}
+
+void fl_menu_item_set_shortcut(MENUITEM mi, int s) {
+ static_cast<Fl_Menu_Item*>(mi)->shortcut(s);
+}
+
+int fl_menu_item_get_flags(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->flags;
+}
+
+void fl_menu_item_set_flags(MENUITEM mi, int f) {
+ static_cast<Fl_Menu_Item*>(mi)->flags = f;
+}
+
+
+
+
+void fl_menu_item_image(MENUITEM mi, void * i) {
+ static_cast<Fl_Menu_Item*>(mi)->image(static_cast<Fl_Image*>(i));
+}
+
+
+
+
+void fl_menu_item_activate(MENUITEM mi) {
+ static_cast<Fl_Menu_Item*>(mi)->activate();
+}
+
+void fl_menu_item_deactivate(MENUITEM mi) {
+ static_cast<Fl_Menu_Item*>(mi)->deactivate();
+}
+
+void fl_menu_item_show(MENUITEM mi) {
+ static_cast<Fl_Menu_Item*>(mi)->show();
+}
+
+void fl_menu_item_hide(MENUITEM mi) {
+ static_cast<Fl_Menu_Item*>(mi)->hide();
+}
+
+int fl_menu_item_active(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->active();
+}
+
+int fl_menu_item_visible(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->visible();
+}
+
+int fl_menu_item_activevisible(MENUITEM mi) {
+ return static_cast<Fl_Menu_Item*>(mi)->activevisible();
+}
+
+
diff --git a/body/c_fl_menuitem.h b/body/c_fl_menuitem.h
new file mode 100644
index 0000000..1e63c60
--- /dev/null
+++ b/body/c_fl_menuitem.h
@@ -0,0 +1,66 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_MENU_ITEM_GUARD
+#define FL_MENU_ITEM_GUARD
+
+
+typedef void* MENUITEM;
+
+
+extern "C" void * null_fl_menu_item();
+extern "C" void * new_fl_menu_item(char * t, void * c, int s, int f);
+extern "C" void free_fl_menu_item(MENUITEM mi);
+
+
+extern "C" void * fl_menu_item_get_user_data(MENUITEM mi);
+extern "C" void fl_menu_item_set_callback(MENUITEM mi, void * c);
+extern "C" void fl_menu_item_do_callback(MENUITEM mi, void * w);
+
+
+extern "C" int fl_menu_item_checkbox(MENUITEM mi);
+extern "C" int fl_menu_item_radio(MENUITEM mi);
+extern "C" int fl_menu_item_submenu(MENUITEM mi);
+extern "C" int fl_menu_item_value(MENUITEM mi);
+extern "C" void fl_menu_item_set(MENUITEM mi);
+extern "C" void fl_menu_item_clear(MENUITEM mi);
+extern "C" void fl_menu_item_setonly(MENUITEM mi);
+
+
+extern "C" const char * fl_menu_item_get_label(MENUITEM mi);
+extern "C" void fl_menu_item_set_label(MENUITEM mi, const char *t);
+extern "C" void fl_menu_item_set_label2(MENUITEM mi, int k, const char * t);
+extern "C" unsigned int fl_menu_item_get_labelcolor(MENUITEM mi);
+extern "C" void fl_menu_item_set_labelcolor(MENUITEM mi, unsigned int c);
+extern "C" int fl_menu_item_get_labelfont(MENUITEM mi);
+extern "C" void fl_menu_item_set_labelfont(MENUITEM mi, int f);
+extern "C" int fl_menu_item_get_labelsize(MENUITEM mi);
+extern "C" void fl_menu_item_set_labelsize(MENUITEM mi, int s);
+extern "C" int fl_menu_item_get_labeltype(MENUITEM mi);
+extern "C" void fl_menu_item_set_labeltype(MENUITEM mi, int t);
+
+
+extern "C" int fl_menu_item_get_shortcut(MENUITEM mi);
+extern "C" void fl_menu_item_set_shortcut(MENUITEM mi, int s);
+extern "C" int fl_menu_item_get_flags(MENUITEM mi);
+extern "C" void fl_menu_item_set_flags(MENUITEM mi, int f);
+
+
+extern "C" void fl_menu_item_image(MENUITEM mi, void * i);
+
+
+extern "C" void fl_menu_item_activate(MENUITEM mi);
+extern "C" void fl_menu_item_deactivate(MENUITEM mi);
+extern "C" void fl_menu_item_show(MENUITEM mi);
+extern "C" void fl_menu_item_hide(MENUITEM mi);
+extern "C" int fl_menu_item_active(MENUITEM mi);
+extern "C" int fl_menu_item_visible(MENUITEM mi);
+extern "C" int fl_menu_item_activevisible(MENUITEM mi);
+
+
+#endif
+
+
diff --git a/body/c_fl_multi_browser.cpp b/body/c_fl_multi_browser.cpp
new file mode 100644
index 0000000..18bf5e8
--- /dev/null
+++ b/body/c_fl_multi_browser.cpp
@@ -0,0 +1,265 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Multi_Browser.H>
+#include "c_fl_multi_browser.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" int browser_full_width_hook(void * b);
+extern "C" int browser_full_height_hook(void * b);
+extern "C" int browser_incr_height_hook(void * b);
+extern "C" int browser_item_quick_height_hook(void * b, void * i);
+
+extern "C" int browser_item_width_hook(void * b, void * i);
+extern "C" int browser_item_height_hook(void * b, void * i);
+extern "C" void * browser_item_first_hook(void * b);
+extern "C" void * browser_item_last_hook(void * b);
+extern "C" void * browser_item_next_hook(void * b, void * i);
+extern "C" void * browser_item_prev_hook(void * b, void * i);
+extern "C" void * browser_item_at_hook(void * b, int n);
+extern "C" void browser_item_select_hook(void * b, void * i, int s);
+extern "C" int browser_item_selected_hook(void * b, void * i);
+extern "C" void browser_item_swap_hook(void * b, void * one, void * two);
+extern "C" const char * browser_item_text_hook(void * b, void * i);
+extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h);
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Multi_Browser : public Fl_Multi_Browser {
+public:
+ using Fl_Multi_Browser::Fl_Multi_Browser;
+
+ friend int fl_multi_browser_item_width(MULTIBROWSER b, void * item);
+ friend int fl_multi_browser_item_height(MULTIBROWSER b, void * item);
+ friend void * fl_multi_browser_item_first(MULTIBROWSER b);
+ friend void * fl_multi_browser_item_last(MULTIBROWSER b);
+ friend void * fl_multi_browser_item_next(MULTIBROWSER b, void * item);
+ friend void * fl_multi_browser_item_prev(MULTIBROWSER b, void * item);
+ friend void * fl_multi_browser_item_at(MULTIBROWSER b, int index);
+ friend void fl_multi_browser_item_select(MULTIBROWSER b, void * item, int val);
+ friend int fl_multi_browser_item_selected(MULTIBROWSER b, void * item);
+ friend void fl_multi_browser_item_swap(MULTIBROWSER b, void * x, void * y);
+ friend const char * fl_multi_browser_item_text(MULTIBROWSER b, void * item);
+ friend void fl_multi_browser_item_draw(MULTIBROWSER b, void * item, int x, int y, int w, int h);
+
+ friend int fl_multi_browser_full_width(MULTIBROWSER c);
+ friend int fl_multi_browser_full_height(MULTIBROWSER c);
+ friend int fl_multi_browser_incr_height(MULTIBROWSER c);
+ friend int fl_multi_browser_item_quick_height(MULTIBROWSER c, void * i);
+
+ friend void fl_multi_browser_draw(MULTIBROWSER b);
+
+ int handle(int e);
+
+protected:
+ int full_width() const;
+ int full_height() const;
+ int incr_height() const;
+ int item_quick_height(void * item) const;
+
+ int item_width(void * item) const;
+ int item_height(void * item) const;
+ void * item_first() const;
+ void * item_last() const;
+ void * item_next(void * item) const;
+ void * item_prev(void * item) const;
+ void * item_at(int index) const;
+ void item_select(void * item, int val=1);
+ int item_selected(void * item) const;
+ void item_swap(void * a, void * b);
+ const char * item_text(void * item) const;
+ void item_draw(void * item, int x, int y, int w, int h) const;
+
+ void draw();
+};
+
+
+int My_Multi_Browser::full_width() const {
+ return browser_full_width_hook(this->user_data());
+}
+
+int My_Multi_Browser::full_height() const {
+ return browser_full_height_hook(this->user_data());
+}
+
+int My_Multi_Browser::incr_height() const {
+ return browser_incr_height_hook(this->user_data());
+}
+
+int My_Multi_Browser::item_quick_height(void * item) const {
+ return browser_item_quick_height_hook(this->user_data(), item);
+}
+
+
+int My_Multi_Browser::item_width(void * item) const {
+ return browser_item_width_hook(this->user_data(), item);
+}
+
+int My_Multi_Browser::item_height(void * item) const {
+ return browser_item_height_hook(this->user_data(), item);
+}
+
+void * My_Multi_Browser::item_first() const {
+ return browser_item_first_hook(this->user_data());
+}
+
+void * My_Multi_Browser::item_last() const {
+ return browser_item_last_hook(this->user_data());
+}
+
+void * My_Multi_Browser::item_next(void * item) const {
+ return browser_item_next_hook(this->user_data(), item);
+}
+
+void * My_Multi_Browser::item_prev(void * item) const {
+ return browser_item_prev_hook(this->user_data(), item);
+}
+
+void * My_Multi_Browser::item_at(int index) const {
+ return browser_item_at_hook(this->user_data(), index);
+}
+
+void My_Multi_Browser::item_select(void * item, int val) {
+ browser_item_select_hook(this->user_data(), item, val);
+}
+
+int My_Multi_Browser::item_selected(void * item) const {
+ return browser_item_selected_hook(this->user_data(), item);
+}
+
+void My_Multi_Browser::item_swap(void * a, void * b) {
+ browser_item_swap_hook(this->user_data(), a, b);
+}
+
+const char * My_Multi_Browser::item_text(void * item) const {
+ return browser_item_text_hook(this->user_data(), item);
+}
+
+void My_Multi_Browser::item_draw(void * item, int x, int y, int w, int h) const {
+ browser_item_draw_hook(this->user_data(), item, x, y, w, h);
+}
+
+
+void My_Multi_Browser::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Multi_Browser::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API begins here
+
+MULTIBROWSER new_fl_multi_browser(int x, int y, int w, int h, char * label) {
+ My_Multi_Browser *b = new My_Multi_Browser(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_multi_browser(MULTIBROWSER b) {
+ delete static_cast<My_Multi_Browser*>(b);
+}
+
+
+
+
+// These have to be reimplemented due to relying on custom class extensions
+
+
+int fl_multi_browser_full_height(MULTIBROWSER c) {
+ return static_cast<My_Multi_Browser*>(c)->Fl_Multi_Browser::full_height();
+}
+
+int fl_multi_browser_incr_height(MULTIBROWSER c) {
+ return static_cast<My_Multi_Browser*>(c)->Fl_Multi_Browser::incr_height();
+}
+
+
+
+
+int fl_multi_browser_item_width(MULTIBROWSER b, void * item) {
+ return static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_width(item);
+}
+
+int fl_multi_browser_item_height(MULTIBROWSER b, void * item) {
+ return static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_height(item);
+}
+
+void * fl_multi_browser_item_first(MULTIBROWSER b) {
+ return static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_first();
+}
+
+void * fl_multi_browser_item_last(MULTIBROWSER b) {
+ return static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_last();
+}
+
+void * fl_multi_browser_item_next(MULTIBROWSER b, void * item) {
+ return static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_next(item);
+}
+
+void * fl_multi_browser_item_prev(MULTIBROWSER b, void * item) {
+ return static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_prev(item);
+}
+
+void * fl_multi_browser_item_at(MULTIBROWSER b, int index) {
+ return static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_at(index);
+}
+
+void fl_multi_browser_item_select(MULTIBROWSER b, void * item, int val) {
+ static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_select(item, val);
+}
+
+int fl_multi_browser_item_selected(MULTIBROWSER b, void * item) {
+ return static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_selected(item);
+}
+
+void fl_multi_browser_item_swap(MULTIBROWSER b, void * x, void * y) {
+ static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_swap(x, y);
+}
+
+const char * fl_multi_browser_item_text(MULTIBROWSER b, void * item) {
+ return static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_text(item);
+}
+
+void fl_multi_browser_item_draw(MULTIBROWSER b, void * item, int x, int y, int w, int h) {
+ static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::item_draw(item, x, y, w, h);
+}
+
+
+
+
+int fl_multi_browser_full_width(MULTIBROWSER c) {
+ return static_cast<My_Multi_Browser*>(c)->Fl_Multi_Browser::full_width();
+}
+
+int fl_multi_browser_item_quick_height(MULTIBROWSER c, void * i) {
+ return static_cast<My_Multi_Browser*>(c)->Fl_Multi_Browser::item_quick_height(i);
+}
+
+
+
+
+void fl_multi_browser_draw(MULTIBROWSER b) {
+ static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::draw();
+}
+
+int fl_multi_browser_handle(MULTIBROWSER b, int e) {
+ return static_cast<My_Multi_Browser*>(b)->Fl_Multi_Browser::handle(e);
+}
+
+
diff --git a/body/c_fl_multi_browser.h b/body/c_fl_multi_browser.h
new file mode 100644
index 0000000..29d18ec
--- /dev/null
+++ b/body/c_fl_multi_browser.h
@@ -0,0 +1,48 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_MULTI_BROWSER_GUARD
+#define FL_MULTI_BROWSER_GUARD
+
+
+typedef void* MULTIBROWSER;
+
+
+extern "C" MULTIBROWSER new_fl_multi_browser(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_multi_browser(MULTIBROWSER b);
+
+
+// reimp below here
+
+extern "C" int fl_multi_browser_full_height(MULTIBROWSER c);
+extern "C" int fl_multi_browser_incr_height(MULTIBROWSER c);
+
+
+extern "C" int fl_multi_browser_item_width(MULTIBROWSER b, void * item);
+extern "C" int fl_multi_browser_item_height(MULTIBROWSER b, void * item);
+extern "C" void * fl_multi_browser_item_first(MULTIBROWSER b);
+extern "C" void * fl_multi_browser_item_last(MULTIBROWSER b);
+extern "C" void * fl_multi_browser_item_next(MULTIBROWSER b, void * item);
+extern "C" void * fl_multi_browser_item_prev(MULTIBROWSER b, void * item);
+extern "C" void * fl_multi_browser_item_at(MULTIBROWSER b, int index);
+extern "C" void fl_multi_browser_item_select(MULTIBROWSER b, void * item, int val=1);
+extern "C" int fl_multi_browser_item_selected(MULTIBROWSER b, void * item);
+extern "C" void fl_multi_browser_item_swap(MULTIBROWSER b, void * x, void * y);
+extern "C" const char * fl_multi_browser_item_text(MULTIBROWSER b, void * item);
+extern "C" void fl_multi_browser_item_draw(MULTIBROWSER b, void * item, int x, int y, int w, int h);
+
+
+extern "C" int fl_multi_browser_full_width(MULTIBROWSER c);
+extern "C" int fl_multi_browser_item_quick_height(MULTIBROWSER c, void * i);
+
+
+extern "C" void fl_multi_browser_draw(MULTIBROWSER b);
+extern "C" int fl_multi_browser_handle(MULTIBROWSER b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_multiline_input.cpp b/body/c_fl_multiline_input.cpp
new file mode 100644
index 0000000..ee99a13
--- /dev/null
+++ b/body/c_fl_multiline_input.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Multiline_Input.H>
+#include "c_fl_multiline_input.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Multiline_Input : public Fl_Multiline_Input {
+public:
+ using Fl_Multiline_Input::Fl_Multiline_Input;
+
+ friend void fl_multiline_input_draw(MULTILINEINPUT i);
+ friend int fl_multiline_input_handle(MULTILINEINPUT i, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Multiline_Input::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Multiline_Input::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+MULTILINEINPUT new_fl_multiline_input(int x, int y, int w, int h, char* label) {
+ My_Multiline_Input *i = new My_Multiline_Input(x, y, w, h, label);
+ return i;
+}
+
+void free_fl_multiline_input(MULTILINEINPUT i) {
+ delete static_cast<My_Multiline_Input*>(i);
+}
+
+
+
+
+void fl_multiline_input_draw(MULTILINEINPUT i) {
+ static_cast<My_Multiline_Input*>(i)->Fl_Multiline_Input::draw();
+}
+
+int fl_multiline_input_handle(MULTILINEINPUT i, int e) {
+ return static_cast<My_Multiline_Input*>(i)->Fl_Multiline_Input::handle(e);
+}
+
+
diff --git a/body/c_fl_multiline_input.h b/body/c_fl_multiline_input.h
new file mode 100644
index 0000000..ba4e723
--- /dev/null
+++ b/body/c_fl_multiline_input.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_MULTILINE_INPUT_GUARD
+#define FL_MULTILINE_INPUT_GUARD
+
+
+typedef void* MULTILINEINPUT;
+
+
+extern "C" MULTILINEINPUT new_fl_multiline_input(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_multiline_input(MULTILINEINPUT i);
+
+
+extern "C" void fl_multiline_input_draw(MULTILINEINPUT i);
+extern "C" int fl_multiline_input_handle(MULTILINEINPUT i, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_multiline_output.cpp b/body/c_fl_multiline_output.cpp
new file mode 100644
index 0000000..2401fc7
--- /dev/null
+++ b/body/c_fl_multiline_output.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Multiline_Output.H>
+#include "c_fl_multiline_output.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Multiline_Output : public Fl_Multiline_Output {
+public:
+ using Fl_Multiline_Output::Fl_Multiline_Output;
+
+ friend void fl_multiline_output_draw(MULTILINEOUTPUT i);
+ friend int fl_multiline_output_handle(MULTILINEOUTPUT i, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Multiline_Output::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Multiline_Output::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+MULTILINEOUTPUT new_fl_multiline_output(int x, int y, int w, int h, char* label) {
+ My_Multiline_Output *i = new My_Multiline_Output(x, y, w, h, label);
+ return i;
+}
+
+void free_fl_multiline_output(MULTILINEOUTPUT i) {
+ delete static_cast<My_Multiline_Output*>(i);
+}
+
+
+
+
+void fl_multiline_output_draw(MULTILINEOUTPUT i) {
+ static_cast<My_Multiline_Output*>(i)->Fl_Multiline_Output::draw();
+}
+
+int fl_multiline_output_handle(MULTILINEOUTPUT i, int e) {
+ return static_cast<My_Multiline_Output*>(i)->Fl_Multiline_Output::handle(e);
+}
+
+
diff --git a/body/c_fl_multiline_output.h b/body/c_fl_multiline_output.h
new file mode 100644
index 0000000..43fee90
--- /dev/null
+++ b/body/c_fl_multiline_output.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_MULTILINE_OUTPUT_GUARD
+#define FL_MULTILINE_OUTPUT_GUARD
+
+
+typedef void* MULTILINEOUTPUT;
+
+
+extern "C" MULTILINEOUTPUT new_fl_multiline_output(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_multiline_output(MULTILINEOUTPUT i);
+
+
+extern "C" void fl_multiline_output_draw(MULTILINEOUTPUT i);
+extern "C" int fl_multiline_output_handle(MULTILINEOUTPUT i, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_nice_slider.cpp b/body/c_fl_nice_slider.cpp
new file mode 100644
index 0000000..082bbfc
--- /dev/null
+++ b/body/c_fl_nice_slider.cpp
@@ -0,0 +1,74 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Nice_Slider.H>
+#include "c_fl_nice_slider.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Nice_Slider : public Fl_Nice_Slider {
+public:
+ using Fl_Nice_Slider::Fl_Nice_Slider;
+
+ friend void fl_nice_slider_draw(NICESLIDER s);
+ friend int fl_nice_slider_handle(NICESLIDER s, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Nice_Slider::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Nice_Slider::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Nice_Slider::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+NICESLIDER new_fl_nice_slider(int x, int y, int w, int h, char* label) {
+ My_Nice_Slider *s = new My_Nice_Slider(x, y, w, h, label);
+ return s;
+}
+
+void free_fl_nice_slider(NICESLIDER s) {
+ delete static_cast<My_Nice_Slider*>(s);
+}
+
+
+
+
+void fl_nice_slider_draw(NICESLIDER s) {
+ static_cast<My_Nice_Slider*>(s)->Fl_Nice_Slider::draw();
+}
+
+int fl_nice_slider_handle(NICESLIDER s, int e) {
+ return static_cast<My_Nice_Slider*>(s)->Fl_Nice_Slider::handle(e);
+}
+
+
diff --git a/body/c_fl_nice_slider.h b/body/c_fl_nice_slider.h
new file mode 100644
index 0000000..2da3207
--- /dev/null
+++ b/body/c_fl_nice_slider.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_NICE_SLIDER_GUARD
+#define FL_NICE_SLIDER_GUARD
+
+
+typedef void* NICESLIDER;
+
+
+extern "C" NICESLIDER new_fl_nice_slider(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_nice_slider(NICESLIDER s);
+
+
+extern "C" void fl_nice_slider_draw(NICESLIDER s);
+extern "C" int fl_nice_slider_handle(NICESLIDER s, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_output.cpp b/body/c_fl_output.cpp
new file mode 100644
index 0000000..2e937dd
--- /dev/null
+++ b/body/c_fl_output.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Output.H>
+#include "c_fl_output.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Output : public Fl_Output {
+public:
+ using Fl_Output::Fl_Output;
+
+ friend void fl_output_draw(OUTPUTT i);
+ friend int fl_output_handle(OUTPUTT i, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Output::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Output::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+OUTPUTT new_fl_output(int x, int y, int w, int h, char* label) {
+ My_Output *i = new My_Output(x, y, w, h, label);
+ return i;
+}
+
+void free_fl_output(OUTPUTT i) {
+ delete static_cast<My_Output*>(i);
+}
+
+
+
+
+void fl_output_draw(OUTPUTT i) {
+ static_cast<My_Output*>(i)->Fl_Output::draw();
+}
+
+int fl_output_handle(OUTPUTT i, int e) {
+ return static_cast<My_Output*>(i)->Fl_Output::handle(e);
+}
+
+
diff --git a/body/c_fl_output.h b/body/c_fl_output.h
new file mode 100644
index 0000000..174c32e
--- /dev/null
+++ b/body/c_fl_output.h
@@ -0,0 +1,26 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_OUTPUT_GUARD
+#define FL_OUTPUT_GUARD
+
+
+// using just "OUTPUT" doesn't compile for some reason
+// some sort of name clash?
+typedef void* OUTPUTT;
+
+
+extern "C" OUTPUTT new_fl_output(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_output(OUTPUTT i);
+
+
+extern "C" void fl_output_draw(OUTPUTT i);
+extern "C" int fl_output_handle(OUTPUTT i, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_overlay_window.cpp b/body/c_fl_overlay_window.cpp
new file mode 100644
index 0000000..0d434c3
--- /dev/null
+++ b/body/c_fl_overlay_window.cpp
@@ -0,0 +1,116 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Overlay_Window.H>
+#include "c_fl_overlay_window.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" void overlay_window_draw_overlay_hook(void * ud);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Overlay_Window : public Fl_Overlay_Window {
+public:
+ using Fl_Overlay_Window::Fl_Overlay_Window;
+
+ friend OVERLAYWINDOW new_fl_overlay_window(int x, int y, int w, int h, char *label);
+ friend OVERLAYWINDOW new_fl_overlay_window2(int w, int h, char *label);
+
+ friend void fl_overlay_window_draw(OVERLAYWINDOW w);
+ friend int fl_overlay_window_handle(OVERLAYWINDOW w, int e);
+
+ void draw();
+ void draw_overlay();
+ int handle(int e);
+};
+
+void My_Overlay_Window::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+void My_Overlay_Window::draw_overlay() {
+ overlay_window_draw_overlay_hook(this->user_data());
+}
+
+int My_Overlay_Window::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+OVERLAYWINDOW new_fl_overlay_window(int x, int y, int w, int h, char *label) {
+ My_Overlay_Window *ow = new My_Overlay_Window(x, y, w, h, label);
+ return ow;
+}
+
+OVERLAYWINDOW new_fl_overlay_window2(int w, int h, char *label) {
+ My_Overlay_Window *ow = new My_Overlay_Window(w, h, label);
+ return ow;
+}
+
+void free_fl_overlay_window(OVERLAYWINDOW w) {
+ delete static_cast<My_Overlay_Window*>(w);
+}
+
+
+
+
+int fl_overlay_window_can_do_overlay(OVERLAYWINDOW w) {
+ return static_cast<Fl_Overlay_Window*>(w)->can_do_overlay();
+}
+
+void fl_overlay_window_resize(OVERLAYWINDOW ow, int x, int y, int w, int h) {
+ static_cast<Fl_Overlay_Window*>(ow)->resize(x, y, w, h);
+}
+
+
+
+
+void fl_overlay_window_show(OVERLAYWINDOW w) {
+ static_cast<Fl_Overlay_Window*>(w)->show();
+}
+
+void fl_overlay_window_show2(OVERLAYWINDOW w, int c, void * v) {
+ static_cast<Fl_Overlay_Window*>(w)->show(c, static_cast<char**>(v));
+}
+
+void fl_overlay_window_hide(OVERLAYWINDOW w) {
+ static_cast<Fl_Overlay_Window*>(w)->hide();
+}
+
+void fl_overlay_window_flush(OVERLAYWINDOW w) {
+ static_cast<Fl_Overlay_Window*>(w)->flush();
+}
+
+
+
+
+void fl_overlay_window_redraw_overlay(OVERLAYWINDOW w) {
+ static_cast<Fl_Overlay_Window*>(w)->redraw_overlay();
+}
+
+void fl_overlay_window_draw(OVERLAYWINDOW w) {
+ static_cast<My_Overlay_Window*>(w)->Fl_Overlay_Window::draw();
+}
+
+int fl_overlay_window_handle(OVERLAYWINDOW w, int e) {
+ return static_cast<My_Overlay_Window*>(w)->Fl_Overlay_Window::handle(e);
+}
+
+
diff --git a/body/c_fl_overlay_window.h b/body/c_fl_overlay_window.h
new file mode 100644
index 0000000..a94bbec
--- /dev/null
+++ b/body/c_fl_overlay_window.h
@@ -0,0 +1,36 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_OVERLAY_WINDOW_GUARD
+#define FL_OVERLAY_WINDOW_GUARD
+
+
+typedef void* OVERLAYWINDOW;
+
+
+extern "C" OVERLAYWINDOW new_fl_overlay_window(int x, int y, int w, int h, char *label);
+extern "C" OVERLAYWINDOW new_fl_overlay_window2(int w, int h, char *label);
+extern "C" void free_fl_overlay_window(OVERLAYWINDOW w);
+
+
+extern "C" int fl_overlay_window_can_do_overlay(OVERLAYWINDOW w);
+extern "C" void fl_overlay_window_resize(OVERLAYWINDOW ow, int x, int y, int w, int h);
+
+
+extern "C" void fl_overlay_window_show(OVERLAYWINDOW w);
+extern "C" void fl_overlay_window_show2(OVERLAYWINDOW w, int c, void * v);
+extern "C" void fl_overlay_window_hide(OVERLAYWINDOW w);
+extern "C" void fl_overlay_window_flush(OVERLAYWINDOW w);
+
+
+extern "C" void fl_overlay_window_redraw_overlay(OVERLAYWINDOW w);
+extern "C" void fl_overlay_window_draw(OVERLAYWINDOW w);
+extern "C" int fl_overlay_window_handle(OVERLAYWINDOW w, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_pack.cpp b/body/c_fl_pack.cpp
new file mode 100644
index 0000000..e7cace9
--- /dev/null
+++ b/body/c_fl_pack.cpp
@@ -0,0 +1,78 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Pack.H>
+#include "c_fl_pack.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Pack : public Fl_Pack {
+public:
+ using Fl_Pack::Fl_Pack;
+
+ friend void fl_pack_draw(PACK n);
+ friend int fl_pack_handle(PACK n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Pack::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Pack::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+PACK new_fl_pack(int x, int y, int w, int h, char* label) {
+ My_Pack *b = new My_Pack(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_pack(PACK p) {
+ delete static_cast<My_Pack*>(p);
+}
+
+
+
+
+int fl_pack_get_spacing(PACK p) {
+ return static_cast<Fl_Pack*>(p)->spacing();
+}
+
+void fl_pack_set_spacing(PACK p, int t) {
+ static_cast<Fl_Pack*>(p)->spacing(t);
+}
+
+
+
+
+void fl_pack_draw(PACK n) {
+ static_cast<My_Pack*>(n)->Fl_Pack::draw();
+}
+
+int fl_pack_handle(PACK n, int e) {
+ return static_cast<My_Pack*>(n)->Fl_Pack::handle(e);
+}
+
+
diff --git a/body/c_fl_pack.h b/body/c_fl_pack.h
new file mode 100644
index 0000000..a8bfe75
--- /dev/null
+++ b/body/c_fl_pack.h
@@ -0,0 +1,28 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_PACK_GUARD
+#define FL_PACK_GUARD
+
+
+typedef void* PACK;
+
+
+extern "C" PACK new_fl_pack(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_pack(PACK p);
+
+
+extern "C" int fl_pack_get_spacing(PACK p);
+extern "C" void fl_pack_set_spacing(PACK p, int t);
+
+
+extern "C" void fl_pack_draw(PACK n);
+extern "C" int fl_pack_handle(PACK n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_paged_device.cpp b/body/c_fl_paged_device.cpp
new file mode 100644
index 0000000..f8f7d60
--- /dev/null
+++ b/body/c_fl_paged_device.cpp
@@ -0,0 +1,154 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Paged_Device.H>
+#include <FL/Fl_Widget.H>
+#include <FL/Fl_Window.H>
+#include "c_fl_paged_device.h"
+
+
+
+
+// Enums and macro constants
+
+const int fl_page_format_media = Fl_Paged_Device::MEDIA;
+
+const int fl_page_layout_portrait = Fl_Paged_Device::PORTRAIT;
+const int fl_page_layout_landscape = Fl_Paged_Device::LANDSCAPE;
+const int fl_page_layout_reversed = Fl_Paged_Device::REVERSED;
+const int fl_page_layout_orientation = Fl_Paged_Device::ORIENTATION;
+
+const int fl_no_page_formats = NO_PAGE_FORMATS;
+
+
+
+
+// Helper functions
+
+void fl_paged_device_get_page_format(int i, const char ** n, int * w, int * h) {
+ *n = Fl_Paged_Device::page_formats[i].name;
+ *w = Fl_Paged_Device::page_formats[i].height;
+ *h = Fl_Paged_Device::page_formats[i].width;
+}
+
+
+
+
+// Adding relevant friends
+
+class My_Paged_Device : public Fl_Paged_Device {
+public:
+ using Fl_Paged_Device::Fl_Paged_Device;
+ friend PAGEDDEVICE new_fl_paged_device(void);
+};
+
+
+
+
+// Flattened C API
+
+PAGEDDEVICE new_fl_paged_device(void) {
+ My_Paged_Device *p = new My_Paged_Device();
+ return p;
+}
+
+void free_fl_paged_device(PAGEDDEVICE p) {
+ delete static_cast<My_Paged_Device*>(p);
+}
+
+
+
+
+int fl_paged_device_start_job(PAGEDDEVICE p, int c) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::start_job(c, 0, 0);
+}
+
+int fl_paged_device_start_job2(PAGEDDEVICE p, int c, int * f, int * t) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::start_job(c, f, t);
+}
+
+void fl_paged_device_end_job(PAGEDDEVICE p) {
+ // virtual so disable dispatch
+ static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::end_job();
+}
+
+int fl_paged_device_start_page(PAGEDDEVICE p) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::start_page();
+}
+
+int fl_paged_device_end_page(PAGEDDEVICE p) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::end_page();
+}
+
+
+
+
+void fl_paged_device_margins(PAGEDDEVICE p, int * l, int * t, int * r, int * b) {
+ // virtual so disable dispatch
+ static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::margins(l,t,r,b);
+}
+
+int fl_paged_device_printable_rect(PAGEDDEVICE p, int * w, int * h) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::printable_rect(w,h);
+}
+
+void fl_paged_device_get_origin(PAGEDDEVICE p, int * x, int * y) {
+ // virtual so disable dispatch
+ static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::origin(x,y);
+}
+
+void fl_paged_device_set_origin(PAGEDDEVICE p, int x, int y) {
+ // virtual so disable dispatch
+ static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::origin(x,y);
+}
+
+void fl_paged_device_rotate(PAGEDDEVICE p, float r) {
+ // virtual so disable dispatch
+ static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::rotate(r);
+}
+
+void fl_paged_device_scale(PAGEDDEVICE p, float x, float y) {
+ // virtual so disable dispatch
+ static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::scale(x,y);
+}
+
+void fl_paged_device_translate(PAGEDDEVICE p, int x, int y) {
+ // virtual so disable dispatch
+ static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::translate(x,y);
+}
+
+void fl_paged_device_untranslate(PAGEDDEVICE p) {
+ // virtual so disable dispatch
+ static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::untranslate();
+}
+
+
+
+
+void fl_paged_device_print_widget(PAGEDDEVICE p, void * i, int dx, int dy) {
+ // virtual so disable dispatch
+ static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::print_widget
+ (static_cast<Fl_Widget*>(i),dx,dy);
+}
+
+void fl_paged_device_print_window(PAGEDDEVICE p, void * i, int dx, int dy) {
+ static_cast<Fl_Paged_Device*>(p)->print_window(static_cast<Fl_Window*>(i),dx,dy);
+}
+
+void fl_paged_device_print_window_part(PAGEDDEVICE p, void * i, int x, int y,
+ int w, int h, int dx, int dy)
+{
+ // virtual so disable dispatch
+ static_cast<Fl_Paged_Device*>(p)->Fl_Paged_Device::print_window_part
+ (static_cast<Fl_Window*>(i),x,y,w,h,dx,dy);
+}
+
+
diff --git a/body/c_fl_paged_device.h b/body/c_fl_paged_device.h
new file mode 100644
index 0000000..90befcf
--- /dev/null
+++ b/body/c_fl_paged_device.h
@@ -0,0 +1,54 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_PAGED_DEVICE_GUARD
+#define FL_PAGED_DEVICE_GUARD
+
+
+extern "C" const int fl_page_format_media;
+extern "C" const int fl_page_layout_portrait;
+extern "C" const int fl_page_layout_landscape;
+extern "C" const int fl_page_layout_reversed;
+extern "C" const int fl_page_layout_orientation;
+extern "C" const int fl_no_page_formats;
+
+
+extern "C" void fl_paged_device_get_page_format(int i, const char ** n, int * w, int * h);
+
+
+typedef void* PAGEDDEVICE;
+
+
+extern "C" PAGEDDEVICE new_fl_paged_device(void);
+extern "C" void free_fl_paged_device(PAGEDDEVICE p);
+
+
+extern "C" int fl_paged_device_start_job(PAGEDDEVICE p, int c);
+extern "C" int fl_paged_device_start_job2(PAGEDDEVICE p, int c, int * f, int * t);
+extern "C" void fl_paged_device_end_job(PAGEDDEVICE p);
+extern "C" int fl_paged_device_start_page(PAGEDDEVICE p);
+extern "C" int fl_paged_device_end_page(PAGEDDEVICE p);
+
+
+extern "C" void fl_paged_device_margins(PAGEDDEVICE p, int * l, int * t, int * r, int * b);
+extern "C" int fl_paged_device_printable_rect(PAGEDDEVICE p, int * w, int * h);
+extern "C" void fl_paged_device_get_origin(PAGEDDEVICE p, int * x, int * y);
+extern "C" void fl_paged_device_set_origin(PAGEDDEVICE p, int x, int y);
+extern "C" void fl_paged_device_rotate(PAGEDDEVICE p, float r);
+extern "C" void fl_paged_device_scale(PAGEDDEVICE p, float x, float y);
+extern "C" void fl_paged_device_translate(PAGEDDEVICE p, int x, int y);
+extern "C" void fl_paged_device_untranslate(PAGEDDEVICE p);
+
+
+extern "C" void fl_paged_device_print_widget(PAGEDDEVICE p, void * i, int dx, int dy);
+extern "C" void fl_paged_device_print_window(PAGEDDEVICE p, void * i, int dx, int dy);
+extern "C" void fl_paged_device_print_window_part(PAGEDDEVICE p, void * i, int x, int y,
+ int w, int h, int dx, int dy);
+
+
+#endif
+
+
diff --git a/body/c_fl_pixmap.cpp b/body/c_fl_pixmap.cpp
new file mode 100644
index 0000000..6ebcb56
--- /dev/null
+++ b/body/c_fl_pixmap.cpp
@@ -0,0 +1,58 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Pixmap.H>
+#include "c_fl_pixmap.h"
+
+
+
+
+void free_fl_pixmap(PIXMAP b) {
+ delete static_cast<Fl_Pixmap*>(b);
+}
+
+PIXMAP fl_pixmap_copy(PIXMAP b, int w, int h) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Pixmap*>(b)->Fl_Pixmap::copy(w, h);
+}
+
+PIXMAP fl_pixmap_copy2(PIXMAP b) {
+ return static_cast<Fl_Pixmap*>(b)->copy();
+}
+
+
+
+
+void fl_pixmap_color_average(PIXMAP p, int c, float b) {
+ // virtual so disable dispatch
+ static_cast<Fl_Pixmap*>(p)->Fl_Pixmap::color_average(c, b);
+}
+
+void fl_pixmap_desaturate(PIXMAP p) {
+ // virtual so disable dispatch
+ static_cast<Fl_Pixmap*>(p)->Fl_Pixmap::desaturate();
+}
+
+
+
+
+void fl_pixmap_uncache(PIXMAP p) {
+ // virtual so disable dispatch
+ static_cast<Fl_Pixmap*>(p)->Fl_Pixmap::uncache();
+}
+
+
+
+
+void fl_pixmap_draw2(PIXMAP b, int x, int y) {
+ static_cast<Fl_Pixmap*>(b)->draw(x, y);
+}
+
+void fl_pixmap_draw(PIXMAP b, int x, int y, int w, int h, int cx, int cy) {
+ // virtual so disable dispatch
+ static_cast<Fl_Pixmap*>(b)->Fl_Pixmap::draw(x, y, w, h, cx, cy);
+}
+
diff --git a/body/c_fl_pixmap.h b/body/c_fl_pixmap.h
new file mode 100644
index 0000000..ceba284
--- /dev/null
+++ b/body/c_fl_pixmap.h
@@ -0,0 +1,32 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_PIXMAP_GUARD
+#define FL_PIXMAP_GUARD
+
+
+typedef void* PIXMAP;
+
+
+extern "C" void free_fl_pixmap(PIXMAP b);
+extern "C" PIXMAP fl_pixmap_copy(PIXMAP b, int w, int h);
+extern "C" PIXMAP fl_pixmap_copy2(PIXMAP b);
+
+
+extern "C" void fl_pixmap_color_average(PIXMAP p, int c, float b);
+extern "C" void fl_pixmap_desaturate(PIXMAP p);
+
+
+extern "C" void fl_pixmap_uncache(PIXMAP p);
+
+
+extern "C" void fl_pixmap_draw2(PIXMAP b, int x, int y);
+extern "C" void fl_pixmap_draw(PIXMAP b, int x, int y, int w, int h, int cx, int cy);
+
+
+#endif
+
+
diff --git a/body/c_fl_png_image.cpp b/body/c_fl_png_image.cpp
new file mode 100644
index 0000000..a4a6d71
--- /dev/null
+++ b/body/c_fl_png_image.cpp
@@ -0,0 +1,26 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_PNG_Image.H>
+#include "c_fl_png_image.h"
+
+
+
+
+PNGIMAGE new_fl_png_image(const char * f) {
+ Fl_PNG_Image *p = new Fl_PNG_Image(f);
+ return p;
+}
+
+PNGIMAGE new_fl_png_image2(const char *name, void *data, int size) {
+ Fl_PNG_Image *p = new Fl_PNG_Image(name, static_cast<uchar*>(data), size);
+ return p;
+}
+
+void free_fl_png_image(PNGIMAGE p) {
+ delete static_cast<Fl_PNG_Image*>(p);
+}
+
diff --git a/body/c_fl_png_image.h b/body/c_fl_png_image.h
new file mode 100644
index 0000000..83344e0
--- /dev/null
+++ b/body/c_fl_png_image.h
@@ -0,0 +1,21 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_PNG_IMAGE_GUARD
+#define FL_PNG_IMAGE_GUARD
+
+
+typedef void* PNGIMAGE;
+
+
+extern "C" PNGIMAGE new_fl_png_image(const char * f);
+extern "C" PNGIMAGE new_fl_png_image2(const char *name, void *data, int size);
+extern "C" void free_fl_png_image(PNGIMAGE p);
+
+
+#endif
+
+
diff --git a/body/c_fl_pnm_image.cpp b/body/c_fl_pnm_image.cpp
new file mode 100644
index 0000000..1550998
--- /dev/null
+++ b/body/c_fl_pnm_image.cpp
@@ -0,0 +1,21 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_PNM_Image.H>
+#include "c_fl_pnm_image.h"
+
+
+
+
+PNMIMAGE new_fl_pnm_image(const char * f) {
+ Fl_PNM_Image *p = new Fl_PNM_Image(f);
+ return p;
+}
+
+void free_fl_pnm_image(PNMIMAGE p) {
+ delete static_cast<Fl_PNM_Image*>(p);
+}
+
diff --git a/body/c_fl_pnm_image.h b/body/c_fl_pnm_image.h
new file mode 100644
index 0000000..6feeff9
--- /dev/null
+++ b/body/c_fl_pnm_image.h
@@ -0,0 +1,20 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_PNM_IMAGE_GUARD
+#define FL_PNM_IMAGE_GUARD
+
+
+typedef void* PNMIMAGE;
+
+
+extern "C" PNMIMAGE new_fl_pnm_image(const char * f);
+extern "C" void free_fl_pnm_image(PNMIMAGE p);
+
+
+#endif
+
+
diff --git a/body/c_fl_positioner.cpp b/body/c_fl_positioner.cpp
new file mode 100644
index 0000000..ce23b64
--- /dev/null
+++ b/body/c_fl_positioner.cpp
@@ -0,0 +1,166 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Positioner.H>
+#include "c_fl_positioner.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Positioner : Fl_Positioner {
+public:
+ // Really only needed for the versions with (x,y,w,h)
+ using Fl_Positioner::draw;
+ using Fl_Positioner::handle;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Positioner : public Fl_Positioner {
+public:
+ using Fl_Positioner::Fl_Positioner;
+
+ friend void fl_positioner_draw(POSITIONER p);
+ friend int fl_positioner_handle(POSITIONER p, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Positioner::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Positioner::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+POSITIONER new_fl_positioner(int x, int y, int w, int h, char* label) {
+ My_Positioner *p = new My_Positioner(x, y, w, h, label);
+ return p;
+}
+
+void free_fl_positioner(POSITIONER p) {
+ delete static_cast<My_Positioner*>(p);
+}
+
+
+
+
+int fl_positioner_set_value(POSITIONER p, double x, double y) {
+ return static_cast<Fl_Positioner*>(p)->value(x, y);
+}
+
+
+
+
+void fl_positioner_xbounds(POSITIONER p, double l, double h) {
+ static_cast<Fl_Positioner*>(p)->xbounds(l, h);
+}
+
+void fl_positioner_xstep(POSITIONER p, double a) {
+ static_cast<Fl_Positioner*>(p)->xstep(a);
+}
+
+double fl_positioner_get_xminimum(POSITIONER p) {
+ return static_cast<Fl_Positioner*>(p)->xminimum();
+}
+
+void fl_positioner_set_xminimum(POSITIONER p, double a) {
+ static_cast<Fl_Positioner*>(p)->xminimum(a);
+}
+
+double fl_positioner_get_xmaximum(POSITIONER p) {
+ return static_cast<Fl_Positioner*>(p)->xmaximum();
+}
+
+void fl_positioner_set_xmaximum(POSITIONER p, double a) {
+ static_cast<Fl_Positioner*>(p)->xmaximum(a);
+}
+
+double fl_positioner_get_xvalue(POSITIONER p) {
+ return static_cast<Fl_Positioner*>(p)->xvalue();
+}
+
+int fl_positioner_set_xvalue(POSITIONER p, double x) {
+ return static_cast<Fl_Positioner*>(p)->xvalue(x);
+}
+
+
+
+
+void fl_positioner_ybounds(POSITIONER p, double l, double h) {
+ static_cast<Fl_Positioner*>(p)->ybounds(l, h);
+}
+
+void fl_positioner_ystep(POSITIONER p, double a) {
+ static_cast<Fl_Positioner*>(p)->ystep(a);
+}
+
+double fl_positioner_get_yminimum(POSITIONER p) {
+ return static_cast<Fl_Positioner*>(p)->yminimum();
+}
+
+void fl_positioner_set_yminimum(POSITIONER p, double a) {
+ static_cast<Fl_Positioner*>(p)->yminimum(a);
+}
+
+double fl_positioner_get_ymaximum(POSITIONER p) {
+ return static_cast<Fl_Positioner*>(p)->ymaximum();
+}
+
+void fl_positioner_set_ymaximum(POSITIONER p, double a) {
+ static_cast<Fl_Positioner*>(p)->ymaximum(a);
+}
+
+double fl_positioner_get_yvalue(POSITIONER p) {
+ return static_cast<Fl_Positioner*>(p)->yvalue();
+}
+
+int fl_positioner_set_yvalue(POSITIONER p, double y) {
+ return static_cast<Fl_Positioner*>(p)->yvalue(y);
+}
+
+
+
+
+void fl_positioner_draw(POSITIONER p) {
+ static_cast<My_Positioner*>(p)->Fl_Positioner::draw();
+}
+
+void fl_positioner_draw2(POSITIONER p, int x, int y, int w, int h) {
+ void (Fl_Positioner::*mydraw)(int,int,int,int) = &Friend_Positioner::draw;
+ (static_cast<Fl_Positioner*>(p)->*mydraw)(x, y, w, h);
+}
+
+int fl_positioner_handle(POSITIONER p, int e) {
+ return static_cast<My_Positioner*>(p)->Fl_Positioner::handle(e);
+}
+
+int fl_positioner_handle2(POSITIONER p, int e, int x, int y, int w, int h) {
+ int (Fl_Positioner::*myhandle)(int,int,int,int,int) = &Friend_Positioner::handle;
+ return (static_cast<Fl_Positioner*>(p)->*myhandle)(e, x, y, w, h);
+}
+
+
diff --git a/body/c_fl_positioner.h b/body/c_fl_positioner.h
new file mode 100644
index 0000000..9fd96d4
--- /dev/null
+++ b/body/c_fl_positioner.h
@@ -0,0 +1,49 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_POSITIONER_GUARD
+#define FL_POSITIONER_GUARD
+
+
+typedef void* POSITIONER;
+
+
+extern "C" POSITIONER new_fl_positioner(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_positioner(POSITIONER p);
+
+
+extern "C" int fl_positioner_set_value(POSITIONER p, double x, double y);
+
+
+extern "C" void fl_positioner_xbounds(POSITIONER p, double l, double h);
+extern "C" void fl_positioner_xstep(POSITIONER p, double a);
+extern "C" double fl_positioner_get_xminimum(POSITIONER p);
+extern "C" void fl_positioner_set_xminimum(POSITIONER p, double a);
+extern "C" double fl_positioner_get_xmaximum(POSITIONER p);
+extern "C" void fl_positioner_set_xmaximum(POSITIONER p, double a);
+extern "C" double fl_positioner_get_xvalue(POSITIONER p);
+extern "C" int fl_positioner_set_xvalue(POSITIONER p, double x);
+
+
+extern "C" void fl_positioner_ybounds(POSITIONER p, double l, double h);
+extern "C" void fl_positioner_ystep(POSITIONER p, double a);
+extern "C" double fl_positioner_get_yminimum(POSITIONER p);
+extern "C" void fl_positioner_set_yminimum(POSITIONER p, double a);
+extern "C" double fl_positioner_get_ymaximum(POSITIONER p);
+extern "C" void fl_positioner_set_ymaximum(POSITIONER p, double a);
+extern "C" double fl_positioner_get_yvalue(POSITIONER p);
+extern "C" int fl_positioner_set_yvalue(POSITIONER p, double y);
+
+
+extern "C" void fl_positioner_draw(POSITIONER p);
+extern "C" void fl_positioner_draw2(POSITIONER p, int x, int y, int w, int h);
+extern "C" int fl_positioner_handle(POSITIONER p, int e);
+extern "C" int fl_positioner_handle2(POSITIONER p, int e, int x, int y, int w, int h);
+
+
+#endif
+
+
diff --git a/body/c_fl_postscript_file_device.cpp b/body/c_fl_postscript_file_device.cpp
new file mode 100644
index 0000000..480d273
--- /dev/null
+++ b/body/c_fl_postscript_file_device.cpp
@@ -0,0 +1,125 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_PostScript.H>
+#include "c_fl_postscript_file_device.h"
+
+
+
+
+// Making available protected methods
+
+class My_PostScript_File_Device : Fl_PostScript_File_Device {
+public:
+ using Fl_PostScript_File_Device::driver;
+};
+
+
+
+
+// Flattened C API
+
+POSTSCRIPTFILEDEVICE new_fl_postscript_file_device(void) {
+ Fl_PostScript_File_Device *p = new Fl_PostScript_File_Device();
+ return p;
+}
+
+void free_fl_postscript_file_device(POSTSCRIPTFILEDEVICE p) {
+ delete static_cast<Fl_PostScript_File_Device*>(p);
+}
+
+
+
+
+const char * fl_postscript_file_device_get_file_chooser_title() {
+ return Fl_PostScript_File_Device::file_chooser_title;
+}
+
+void fl_postscript_file_device_set_file_chooser_title(const char * v) {
+ Fl_PostScript_File_Device::file_chooser_title = v;
+}
+
+
+
+
+void * fl_postscript_file_device_get_driver(POSTSCRIPTFILEDEVICE p) {
+ return (static_cast<Fl_PostScript_File_Device*>(p)->*(&My_PostScript_File_Device::driver))();
+}
+
+
+
+
+int fl_postscript_file_device_start_job(POSTSCRIPTFILEDEVICE p, int c) {
+ return static_cast<Fl_PostScript_File_Device*>(p)->start_job(c, 0, 0);
+}
+
+int fl_postscript_file_device_start_job2(POSTSCRIPTFILEDEVICE p, int c, int * f, int * t) {
+ return static_cast<Fl_PostScript_File_Device*>(p)->start_job(c, f, t);
+}
+
+int fl_postscript_file_device_start_job3(POSTSCRIPTFILEDEVICE p, void * o, int c, int f, int l) {
+ return static_cast<Fl_PostScript_File_Device*>(p)->start_job
+ (static_cast<FILE*>(o),
+ c,
+ static_cast<Fl_Paged_Device::Page_Format>(f),
+ static_cast<Fl_Paged_Device::Page_Layout>(l));
+}
+
+int fl_postscript_file_device_start_job4(POSTSCRIPTFILEDEVICE p, int c, int f, int l) {
+ return static_cast<Fl_PostScript_File_Device*>(p)->start_job
+ (c,
+ static_cast<Fl_Paged_Device::Page_Format>(f),
+ static_cast<Fl_Paged_Device::Page_Layout>(l));
+}
+
+void fl_postscript_file_device_end_job(POSTSCRIPTFILEDEVICE p) {
+ static_cast<Fl_PostScript_File_Device*>(p)->end_job();
+}
+
+int fl_postscript_file_device_start_page(POSTSCRIPTFILEDEVICE p) {
+ return static_cast<Fl_PostScript_File_Device*>(p)->start_page();
+}
+
+int fl_postscript_file_device_end_page(POSTSCRIPTFILEDEVICE p) {
+ return static_cast<Fl_PostScript_File_Device*>(p)->end_page();
+}
+
+
+
+
+void fl_postscript_file_device_margins(POSTSCRIPTFILEDEVICE p, int * l, int * t, int * r, int * b) {
+ static_cast<Fl_PostScript_File_Device*>(p)->margins(l,t,r,b);
+}
+
+int fl_postscript_file_device_printable_rect(POSTSCRIPTFILEDEVICE p, int * w, int * h) {
+ return static_cast<Fl_PostScript_File_Device*>(p)->printable_rect(w,h);
+}
+
+void fl_postscript_file_device_get_origin(POSTSCRIPTFILEDEVICE p, int * x, int * y) {
+ static_cast<Fl_PostScript_File_Device*>(p)->origin(x,y);
+}
+
+void fl_postscript_file_device_set_origin(POSTSCRIPTFILEDEVICE p, int x, int y) {
+ static_cast<Fl_PostScript_File_Device*>(p)->origin(x,y);
+}
+
+void fl_postscript_file_device_rotate(POSTSCRIPTFILEDEVICE p, float r) {
+ static_cast<Fl_PostScript_File_Device*>(p)->rotate(r);
+}
+
+void fl_postscript_file_device_scale(POSTSCRIPTFILEDEVICE p, float x, float y) {
+ static_cast<Fl_PostScript_File_Device*>(p)->scale(x,y);
+}
+
+void fl_postscript_file_device_translate(POSTSCRIPTFILEDEVICE p, int x, int y) {
+ static_cast<Fl_PostScript_File_Device*>(p)->translate(x,y);
+}
+
+void fl_postscript_file_device_untranslate(POSTSCRIPTFILEDEVICE p) {
+ static_cast<Fl_PostScript_File_Device*>(p)->untranslate();
+}
+
+
diff --git a/body/c_fl_postscript_file_device.h b/body/c_fl_postscript_file_device.h
new file mode 100644
index 0000000..f4d6d31
--- /dev/null
+++ b/body/c_fl_postscript_file_device.h
@@ -0,0 +1,47 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_POSTSCRIPT_FILE_DEVICE_GUARD
+#define FL_POSTSCRIPT_FILE_DEVICE_GUARD
+
+
+typedef void* POSTSCRIPTFILEDEVICE;
+
+
+extern "C" POSTSCRIPTFILEDEVICE new_fl_postscript_file_device(void);
+extern "C" void free_fl_postscript_file_device(POSTSCRIPTFILEDEVICE p);
+
+
+extern "C" const char * fl_postscript_file_device_get_file_chooser_title();
+extern "C" void fl_postscript_file_device_set_file_chooser_title(const char * v);
+
+
+extern "C" void * fl_postscript_file_device_get_driver(POSTSCRIPTFILEDEVICE p);
+
+
+extern "C" int fl_postscript_file_device_start_job(POSTSCRIPTFILEDEVICE p, int c);
+extern "C" int fl_postscript_file_device_start_job2(POSTSCRIPTFILEDEVICE p, int c, int * f, int * t);
+extern "C" int fl_postscript_file_device_start_job3(POSTSCRIPTFILEDEVICE p, void * o, int c, int f, int l);
+extern "C" int fl_postscript_file_device_start_job4(POSTSCRIPTFILEDEVICE p, int c, int f, int l);
+extern "C" void fl_postscript_file_device_end_job(POSTSCRIPTFILEDEVICE p);
+extern "C" int fl_postscript_file_device_start_page(POSTSCRIPTFILEDEVICE p);
+extern "C" int fl_postscript_file_device_end_page(POSTSCRIPTFILEDEVICE p);
+
+
+extern "C" void fl_postscript_file_device_margins(POSTSCRIPTFILEDEVICE p, int * l, int * t,
+ int * r, int * b);
+extern "C" int fl_postscript_file_device_printable_rect(POSTSCRIPTFILEDEVICE p, int * w, int * h);
+extern "C" void fl_postscript_file_device_get_origin(POSTSCRIPTFILEDEVICE p, int * x, int * y);
+extern "C" void fl_postscript_file_device_set_origin(POSTSCRIPTFILEDEVICE p, int x, int y);
+extern "C" void fl_postscript_file_device_rotate(POSTSCRIPTFILEDEVICE p, float r);
+extern "C" void fl_postscript_file_device_scale(POSTSCRIPTFILEDEVICE p, float x, float y);
+extern "C" void fl_postscript_file_device_translate(POSTSCRIPTFILEDEVICE p, int x, int y);
+extern "C" void fl_postscript_file_device_untranslate(POSTSCRIPTFILEDEVICE p);
+
+
+#endif
+
+
diff --git a/body/c_fl_preferences.cpp b/body/c_fl_preferences.cpp
new file mode 100644
index 0000000..d2b0d2c
--- /dev/null
+++ b/body/c_fl_preferences.cpp
@@ -0,0 +1,233 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Preferences.H>
+#include <FL/filename.H>
+#include <cstdlib>
+#include "c_fl_preferences.h"
+
+
+
+
+const int root_fl_prefs_system = Fl_Preferences::SYSTEM;
+const int root_fl_prefs_user = Fl_Preferences::USER;
+
+const int const_fl_path_max = FL_PATH_MAX;
+
+
+
+
+const char * fl_preferences_new_uuid() {
+ return Fl_Preferences::newUUID();
+}
+
+
+
+
+class My_Preferences : public Fl_Preferences {
+ public:
+ using Fl_Preferences::Fl_Preferences;
+ int reference_count = 0;
+};
+
+
+
+
+PREFS new_fl_pref_database_path(char * p, char * v, char * a) {
+ My_Preferences *e = new My_Preferences(p, v, a);
+ return e;
+}
+
+PREFS new_fl_pref_database_scope(int s, char * v, char * a) {
+ My_Preferences *e = new My_Preferences((Fl_Preferences::Root)s, v, a);
+ return e;
+}
+
+void upref_fl_pref_database(PREFS e) {
+ static_cast<My_Preferences*>(e)->reference_count += 1;
+}
+
+void free_fl_pref_database(PREFS e) {
+ if (static_cast<My_Preferences*>(e)->reference_count <= 0) {
+ delete static_cast<My_Preferences*>(e);
+ } else {
+ static_cast<My_Preferences*>(e)->reference_count -= 1;
+ }
+}
+
+
+PREFS new_fl_pref_group_copy(PREFS e) {
+ Fl_Preferences *g = new Fl_Preferences(static_cast<Fl_Preferences*>(e));
+ return g;
+}
+
+PREFS new_fl_pref_group_memory(char * n) {
+ Fl_Preferences *g = new Fl_Preferences(NULL, n);
+ return g;
+}
+
+PREFS new_fl_pref_group_name(PREFS e, char * n) {
+ Fl_Preferences *g = new Fl_Preferences(static_cast<Fl_Preferences*>(e), n);
+ return g;
+}
+
+PREFS new_fl_pref_group_index(PREFS e, int i) {
+ Fl_Preferences *g = new Fl_Preferences(static_cast<Fl_Preferences*>(e), i);
+ return g;
+}
+
+void free_fl_pref_group(PREFS e) {
+ delete static_cast<Fl_Preferences*>(e);
+}
+
+
+
+
+void fl_preferences_flush(PREFS e) {
+ static_cast<Fl_Preferences*>(e)->flush();
+}
+
+int fl_preferences_getuserdatapath(PREFS e, char * p, int len) {
+ return (int)static_cast<Fl_Preferences*>(e)->getUserdataPath(p, len);
+}
+
+
+
+
+int fl_preferences_deleteentry(PREFS e, const char * k) {
+ return (int)static_cast<Fl_Preferences*>(e)->deleteEntry(k);
+}
+
+int fl_preferences_deleteallentries(PREFS e) {
+ return (int)static_cast<Fl_Preferences*>(e)->deleteAllEntries();
+}
+
+int fl_preferences_deletegroup(PREFS e, const char * g) {
+ return (int)static_cast<Fl_Preferences*>(e)->deleteGroup(g);
+}
+
+int fl_preferences_deleteallgroups(PREFS e) {
+ return (int)static_cast<Fl_Preferences*>(e)->deleteAllGroups();
+}
+
+int fl_preferences_clear(PREFS e) {
+ return (int)static_cast<Fl_Preferences*>(e)->clear();
+}
+
+
+
+
+int fl_preferences_entries(PREFS e) {
+ return static_cast<Fl_Preferences*>(e)->entries();
+}
+
+const char * fl_preferences_entry(PREFS e, int i) {
+ return static_cast<Fl_Preferences*>(e)->entry(i);
+}
+
+int fl_preferences_entryexists(PREFS e, const char * k) {
+ return (int)static_cast<Fl_Preferences*>(e)->entryExists(k);
+}
+
+int fl_preferences_size(PREFS e, const char * k) {
+ return static_cast<Fl_Preferences*>(e)->size(k);
+}
+
+
+
+
+int fl_preferences_groups(PREFS e) {
+ return static_cast<Fl_Preferences*>(e)->groups();
+}
+
+const char * fl_preferences_group(PREFS e, int i) {
+ return static_cast<Fl_Preferences*>(e)->group(i);
+}
+
+int fl_preferences_groupexists(PREFS e, const char * g) {
+ return (int)static_cast<Fl_Preferences*>(e)->groupExists(g);
+}
+
+
+
+
+const char * fl_preferences_name(PREFS e) {
+ return static_cast<Fl_Preferences*>(e)->name();
+}
+
+const char * fl_preferences_path(PREFS e) {
+ return static_cast<Fl_Preferences*>(e)->path();
+}
+
+
+
+
+int fl_preferences_get_int(PREFS e, const char * k, int& v, int d) {
+ return (int)static_cast<Fl_Preferences*>(e)->get(k,v,d);
+}
+
+int fl_preferences_get_float(PREFS e, const char * k, float& v, float d) {
+ return (int)static_cast<Fl_Preferences*>(e)->get(k,v,d);
+}
+
+int fl_preferences_get_double(PREFS e, const char * k, double& v, double d) {
+ return (int)static_cast<Fl_Preferences*>(e)->get(k,v,d);
+}
+
+// must deallocate result afterwards
+int fl_preferences_get_str(PREFS e, const char * k, char *& v, const char * d) {
+ return (int)static_cast<Fl_Preferences*>(e)->get(k,v,d);
+}
+
+int fl_preferences_get_str_limit (PREFS e, const char * k, char * v, const char * d, int m) {
+ return (int)static_cast<Fl_Preferences*>(e)->get(k, v, d, m);
+}
+
+// must deallocate result afterwards
+int fl_preferences_get_void (PREFS e, const char * k, void *& v, const void * d, int ds) {
+ return (int)static_cast<Fl_Preferences*>(e)->get(k, v, d, ds);
+}
+
+int fl_preferences_get_void_limit (PREFS e, const char * k, void * v, const void * d, int ds, int ms) {
+ return (int)static_cast<Fl_Preferences*>(e)->get(k, v, d, ds, ms);
+}
+
+void free_fl_preferences_void_data(void * v) {
+ free(v);
+}
+
+
+
+
+int fl_preferences_set_int(PREFS e, const char * k, int v) {
+ return (int)static_cast<Fl_Preferences*>(e)->set(k,v);
+}
+
+int fl_preferences_set_float(PREFS e, const char * k, float v) {
+ return (int)static_cast<Fl_Preferences*>(e)->set(k,v);
+}
+
+int fl_preferences_set_float_prec(PREFS e, const char * k, float v, int p) {
+ return (int)static_cast<Fl_Preferences*>(e)->set(k,v,p);
+}
+
+int fl_preferences_set_double(PREFS e, const char * k, double v) {
+ return (int)static_cast<Fl_Preferences*>(e)->set(k,v);
+}
+
+int fl_preferences_set_double_prec(PREFS e, const char * k, double v, int p) {
+ return (int)static_cast<Fl_Preferences*>(e)->set(k,v,p);
+}
+
+int fl_preferences_set_str(PREFS e, const char * k, const char * v) {
+ return (int)static_cast<Fl_Preferences*>(e)->set(k,v);
+}
+
+int fl_preferences_set_void(PREFS e, const char * k, const void * d, int ds) {
+ return (int)static_cast<Fl_Preferences*>(e)->set(k, d, ds);
+}
+
+
diff --git a/body/c_fl_preferences.h b/body/c_fl_preferences.h
new file mode 100644
index 0000000..9f77dfb
--- /dev/null
+++ b/body/c_fl_preferences.h
@@ -0,0 +1,86 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_PREFERENCES_GUARD
+#define FL_PREFERENCES_GUARD
+
+
+typedef void* PREFS;
+
+
+extern const int root_fl_prefs_system;
+extern const int root_fl_prefs_user;
+
+extern const int const_fl_path_max;
+
+
+extern "C" const char * fl_preferences_new_uuid();
+
+
+extern "C" PREFS new_fl_pref_database_path(char * p, char * v, char * a);
+extern "C" PREFS new_fl_pref_database_scope(int s, char * v, char * a);
+extern "C" void upref_fl_pref_database(PREFS e);
+extern "C" void free_fl_pref_database(PREFS e);
+
+extern "C" PREFS new_fl_pref_group_copy(PREFS e);
+extern "C" PREFS new_fl_pref_group_memory(char * n);
+extern "C" PREFS new_fl_pref_group_name(PREFS e, char * n);
+extern "C" PREFS new_fl_pref_group_index(PREFS e, int i);
+extern "C" void free_fl_pref_group(PREFS e);
+
+
+extern "C" void fl_preferences_flush(PREFS e);
+extern "C" int fl_preferences_getuserdatapath(PREFS e, char * p, int len);
+
+
+extern "C" int fl_preferences_deleteentry(PREFS e, const char * k);
+extern "C" int fl_preferences_deleteallentries(PREFS e);
+extern "C" int fl_preferences_deletegroup(PREFS e, const char * g);
+extern "C" int fl_preferences_deleteallgroups(PREFS e);
+extern "C" int fl_preferences_clear(PREFS e);
+
+
+extern "C" int fl_preferences_entries(PREFS e);
+extern "C" const char * fl_preferences_entry(PREFS e, int i);
+extern "C" int fl_preferences_entryexists(PREFS e, const char * k);
+extern "C" int fl_preferences_size(PREFS e, const char * k);
+
+
+extern "C" int fl_preferences_groups(PREFS e);
+extern "C" const char * fl_preferences_group(PREFS e, int i);
+extern "C" int fl_preferences_groupexists(PREFS e, const char * g);
+
+
+extern "C" const char * fl_preferences_name(PREFS e);
+extern "C" const char * fl_preferences_path(PREFS e);
+
+
+extern "C" int fl_preferences_get_int(PREFS e, const char * k, int& v, int d);
+extern "C" int fl_preferences_get_float(PREFS e, const char * k, float& v, float d);
+extern "C" int fl_preferences_get_double(PREFS e, const char * k, double& v, double d);
+extern "C" int fl_preferences_get_str
+ (PREFS e, const char * k, char *& v, const char * d);
+extern "C" int fl_preferences_get_str_limit
+ (PREFS e, const char * k, char * v, const char * d, int m);
+extern "C" int fl_preferences_get_void
+ (PREFS e, const char * k, void *& v, const void * d, int ds);
+extern "C" int fl_preferences_get_void_limit
+ (PREFS e, const char * k, void * v, const void * d, int ds, int ms);
+extern "C" void free_fl_preferences_void_data(void * v);
+
+
+extern "C" int fl_preferences_set_int(PREFS e, const char * k, int v);
+extern "C" int fl_preferences_set_float(PREFS e, const char * k, float v);
+extern "C" int fl_preferences_set_float_prec(PREFS e, const char * k, float v, int p);
+extern "C" int fl_preferences_set_double(PREFS e, const char * k, double v);
+extern "C" int fl_preferences_set_double_prec(PREFS e, const char * k, double v, int p);
+extern "C" int fl_preferences_set_str(PREFS e, const char * k, const char * v);
+extern "C" int fl_preferences_set_void(PREFS e, const char * k, const void * d, int ds);
+
+
+#endif
+
+
diff --git a/body/c_fl_printer.cpp b/body/c_fl_printer.cpp
new file mode 100644
index 0000000..94f31d5
--- /dev/null
+++ b/body/c_fl_printer.cpp
@@ -0,0 +1,259 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Printer.H>
+#include <FL/Fl_Widget.H>
+#include <FL/Fl_Window.H>
+#include "c_fl_printer.h"
+
+
+
+
+// Flattened C API
+
+PRINTER new_fl_printer(void) {
+ Fl_Printer *p = new Fl_Printer();
+ return p;
+}
+
+void free_fl_printer(PRINTER p) {
+ delete static_cast<Fl_Printer*>(p);
+}
+
+
+
+
+const char * fl_printer_get_dialog_title() {
+ return Fl_Printer::dialog_title;
+}
+
+void fl_printer_set_dialog_title(const char * v) {
+ Fl_Printer::dialog_title = v;
+}
+
+const char * fl_printer_get_dialog_printer() {
+ return Fl_Printer::dialog_printer;
+}
+
+void fl_printer_set_dialog_printer(const char * v) {
+ Fl_Printer::dialog_printer = v;
+}
+
+const char * fl_printer_get_dialog_range() {
+ return Fl_Printer::dialog_range;
+}
+
+void fl_printer_set_dialog_range(const char * v) {
+ Fl_Printer::dialog_range = v;
+}
+
+const char * fl_printer_get_dialog_copies() {
+ return Fl_Printer::dialog_copies;
+}
+
+void fl_printer_set_dialog_copies(const char * v) {
+ Fl_Printer::dialog_copies = v;
+}
+
+const char * fl_printer_get_dialog_all() {
+ return Fl_Printer::dialog_all;
+}
+
+void fl_printer_set_dialog_all(const char * v) {
+ Fl_Printer::dialog_all = v;
+}
+
+const char * fl_printer_get_dialog_pages() {
+ return Fl_Printer::dialog_pages;
+}
+
+void fl_printer_set_dialog_pages(const char * v) {
+ Fl_Printer::dialog_pages = v;
+}
+
+const char * fl_printer_get_dialog_from() {
+ return Fl_Printer::dialog_from;
+}
+
+void fl_printer_set_dialog_from(const char * v) {
+ Fl_Printer::dialog_from = v;
+}
+
+const char * fl_printer_get_dialog_to() {
+ return Fl_Printer::dialog_to;
+}
+
+void fl_printer_set_dialog_to(const char * v) {
+ Fl_Printer::dialog_to = v;
+}
+
+const char * fl_printer_get_dialog_properties() {
+ return Fl_Printer::dialog_properties;
+}
+
+void fl_printer_set_dialog_properties(const char * v) {
+ Fl_Printer::dialog_properties = v;
+}
+
+const char * fl_printer_get_dialog_copyno() {
+ return Fl_Printer::dialog_copyNo;
+}
+
+void fl_printer_set_dialog_copyno(const char * v) {
+ Fl_Printer::dialog_copyNo = v;
+}
+
+const char * fl_printer_get_dialog_print_button() {
+ return Fl_Printer::dialog_print_button;
+}
+
+void fl_printer_set_dialog_print_button(const char * v) {
+ Fl_Printer::dialog_print_button = v;
+}
+
+const char * fl_printer_get_dialog_cancel_button() {
+ return Fl_Printer::dialog_cancel_button;
+}
+
+void fl_printer_set_dialog_cancel_button(const char * v) {
+ Fl_Printer::dialog_cancel_button = v;
+}
+
+const char * fl_printer_get_dialog_print_to_file() {
+ return Fl_Printer::dialog_print_to_file;
+}
+
+void fl_printer_set_dialog_print_to_file(const char * v) {
+ Fl_Printer::dialog_print_to_file = v;
+}
+
+const char * fl_printer_get_property_title() {
+ return Fl_Printer::property_title;
+}
+
+void fl_printer_set_property_title(const char * v) {
+ Fl_Printer::property_title = v;
+}
+
+const char * fl_printer_get_property_pagesize() {
+ return Fl_Printer::property_pagesize;
+}
+
+void fl_printer_set_property_pagesize(const char * v) {
+ Fl_Printer::property_pagesize = v;
+}
+
+const char * fl_printer_get_property_mode() {
+ return Fl_Printer::property_mode;
+}
+
+void fl_printer_set_property_mode(const char * v) {
+ Fl_Printer::property_mode = v;
+}
+
+const char * fl_printer_get_property_use() {
+ return Fl_Printer::property_use;
+}
+
+void fl_printer_set_property_use(const char * v) {
+ Fl_Printer::property_use = v;
+}
+
+const char * fl_printer_get_property_save() {
+ return Fl_Printer::property_save;
+}
+
+void fl_printer_set_property_save(const char * v) {
+ Fl_Printer::property_save = v;
+}
+
+const char * fl_printer_get_property_cancel() {
+ return Fl_Printer::property_cancel;
+}
+
+void fl_printer_set_property_cancel(const char * v) {
+ Fl_Printer::property_cancel = v;
+}
+
+
+
+
+int fl_printer_start_job(PRINTER p, int c) {
+ return static_cast<Fl_Printer*>(p)->start_job(c, 0, 0);
+}
+
+int fl_printer_start_job2(PRINTER p, int c, int * f, int * t) {
+ return static_cast<Fl_Printer*>(p)->start_job(c, f, t);
+}
+
+void fl_printer_end_job(PRINTER p) {
+ static_cast<Fl_Printer*>(p)->end_job();
+}
+
+int fl_printer_start_page(PRINTER p) {
+ return static_cast<Fl_Printer*>(p)->start_page();
+}
+
+int fl_printer_end_page(PRINTER p) {
+ return static_cast<Fl_Printer*>(p)->end_page();
+}
+
+
+
+
+void fl_printer_margins(PRINTER p, int * l, int * t, int * r, int * b) {
+ static_cast<Fl_Printer*>(p)->margins(l,t,r,b);
+}
+
+int fl_printer_printable_rect(PRINTER p, int * w, int * h) {
+ return static_cast<Fl_Printer*>(p)->printable_rect(w,h);
+}
+
+void fl_printer_get_origin(PRINTER p, int * x, int * y) {
+ static_cast<Fl_Printer*>(p)->origin(x,y);
+}
+
+void fl_printer_set_origin(PRINTER p, int x, int y) {
+ static_cast<Fl_Printer*>(p)->origin(x,y);
+}
+
+void fl_printer_rotate(PRINTER p, float r) {
+ static_cast<Fl_Printer*>(p)->rotate(r);
+}
+
+void fl_printer_scale(PRINTER p, float x, float y) {
+ static_cast<Fl_Printer*>(p)->scale(x,y);
+}
+
+void fl_printer_translate(PRINTER p, int x, int y) {
+ static_cast<Fl_Printer*>(p)->translate(x,y);
+}
+
+void fl_printer_untranslate(PRINTER p) {
+ static_cast<Fl_Printer*>(p)->untranslate();
+}
+
+
+
+
+void fl_printer_print_widget(PRINTER p, void * i, int dx, int dy) {
+ static_cast<Fl_Printer*>(p)->print_widget(static_cast<Fl_Widget*>(i),dx,dy);
+}
+
+void fl_printer_print_window_part(PRINTER p, void * i, int x, int y,
+ int w, int h, int dx, int dy)
+{
+ static_cast<Fl_Printer*>(p)->print_window_part(static_cast<Fl_Window*>(i),x,y,w,h,dx,dy);
+}
+
+
+
+
+void fl_printer_set_current(PRINTER p) {
+ static_cast<Fl_Printer*>(p)->set_current();
+}
+
+
diff --git a/body/c_fl_printer.h b/body/c_fl_printer.h
new file mode 100644
index 0000000..90f070d
--- /dev/null
+++ b/body/c_fl_printer.h
@@ -0,0 +1,85 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_PRINTER_GUARD
+#define FL_PRINTER_GUARD
+
+
+typedef void* PRINTER;
+
+
+extern "C" PRINTER new_fl_printer(void);
+extern "C" void free_fl_printer(PRINTER p);
+
+
+extern "C" const char * fl_printer_get_dialog_title();
+extern "C" void fl_printer_set_dialog_title(const char * v);
+extern "C" const char * fl_printer_get_dialog_printer();
+extern "C" void fl_printer_set_dialog_printer(const char * v);
+extern "C" const char * fl_printer_get_dialog_range();
+extern "C" void fl_printer_set_dialog_range(const char * v);
+extern "C" const char * fl_printer_get_dialog_copies();
+extern "C" void fl_printer_set_dialog_copies(const char * v);
+extern "C" const char * fl_printer_get_dialog_all();
+extern "C" void fl_printer_set_dialog_all(const char * v);
+extern "C" const char * fl_printer_get_dialog_pages();
+extern "C" void fl_printer_set_dialog_pages(const char * v);
+extern "C" const char * fl_printer_get_dialog_from();
+extern "C" void fl_printer_set_dialog_from(const char * v);
+extern "C" const char * fl_printer_get_dialog_to();
+extern "C" void fl_printer_set_dialog_to(const char * v);
+extern "C" const char * fl_printer_get_dialog_properties();
+extern "C" void fl_printer_set_dialog_properties(const char * v);
+extern "C" const char * fl_printer_get_dialog_copyno();
+extern "C" void fl_printer_set_dialog_copyno(const char * v);
+extern "C" const char * fl_printer_get_dialog_print_button();
+extern "C" void fl_printer_set_dialog_print_button(const char * v);
+extern "C" const char * fl_printer_get_dialog_cancel_button();
+extern "C" void fl_printer_set_dialog_cancel_button(const char * v);
+extern "C" const char * fl_printer_get_dialog_print_to_file();
+extern "C" void fl_printer_set_dialog_print_to_file(const char * v);
+extern "C" const char * fl_printer_get_property_title();
+extern "C" void fl_printer_set_property_title(const char * v);
+extern "C" const char * fl_printer_get_property_pagesize();
+extern "C" void fl_printer_set_property_pagesize(const char * v);
+extern "C" const char * fl_printer_get_property_mode();
+extern "C" void fl_printer_set_property_mode(const char * v);
+extern "C" const char * fl_printer_get_property_use();
+extern "C" void fl_printer_set_property_use(const char * v);
+extern "C" const char * fl_printer_get_property_save();
+extern "C" void fl_printer_set_property_save(const char * v);
+extern "C" const char * fl_printer_get_property_cancel();
+extern "C" void fl_printer_set_property_cancel(const char * v);
+
+
+extern "C" int fl_printer_start_job(PRINTER p, int c);
+extern "C" int fl_printer_start_job2(PRINTER p, int c, int * f, int * t);
+extern "C" void fl_printer_end_job(PRINTER p);
+extern "C" int fl_printer_start_page(PRINTER p);
+extern "C" int fl_printer_end_page(PRINTER p);
+
+
+extern "C" void fl_printer_margins(PRINTER p, int * l, int * t, int * r, int * b);
+extern "C" int fl_printer_printable_rect(PRINTER p, int * w, int * h);
+extern "C" void fl_printer_get_origin(PRINTER p, int * x, int * y);
+extern "C" void fl_printer_set_origin(PRINTER p, int x, int y);
+extern "C" void fl_printer_rotate(PRINTER p, float r);
+extern "C" void fl_printer_scale(PRINTER p, float x, float y);
+extern "C" void fl_printer_translate(PRINTER p, int x, int y);
+extern "C" void fl_printer_untranslate(PRINTER p);
+
+
+extern "C" void fl_printer_print_widget(PRINTER p, void * i, int dx, int dy);
+extern "C" void fl_printer_print_window_part(PRINTER p, void * i, int x, int y,
+ int w, int h, int dx, int dy);
+
+
+extern "C" void fl_printer_set_current(PRINTER p);
+
+
+#endif
+
+
diff --git a/body/c_fl_progress.cpp b/body/c_fl_progress.cpp
new file mode 100644
index 0000000..21a7a2d
--- /dev/null
+++ b/body/c_fl_progress.cpp
@@ -0,0 +1,94 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Progress.H>
+#include "c_fl_progress.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Progress : public Fl_Progress {
+public:
+ using Fl_Progress::Fl_Progress;
+
+ friend void fl_progress_draw(PROGRESS p);
+ friend int fl_progress_handle(PROGRESS p, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Progress::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Progress::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+PROGRESS new_fl_progress(int x, int y, int w, int h, char* label) {
+ My_Progress *p = new My_Progress(x, y, w, h, label);
+ return p;
+}
+
+void free_fl_progress(PROGRESS p) {
+ delete static_cast<My_Progress*>(p);
+}
+
+
+
+
+float fl_progress_get_minimum(PROGRESS p) {
+ return static_cast<Fl_Progress*>(p)->minimum();
+}
+
+void fl_progress_set_minimum(PROGRESS p, float t) {
+ static_cast<Fl_Progress*>(p)->minimum(t);
+}
+
+float fl_progress_get_maximum(PROGRESS p) {
+ return static_cast<Fl_Progress*>(p)->maximum();
+}
+
+void fl_progress_set_maximum(PROGRESS p, float t) {
+ static_cast<Fl_Progress*>(p)->maximum(t);
+}
+
+float fl_progress_get_value(PROGRESS p) {
+ return static_cast<Fl_Progress*>(p)->value();
+}
+
+void fl_progress_set_value(PROGRESS p, float t) {
+ static_cast<Fl_Progress*>(p)->value(t);
+}
+
+
+
+
+void fl_progress_draw(PROGRESS p) {
+ static_cast<My_Progress*>(p)->Fl_Progress::draw();
+}
+
+int fl_progress_handle(PROGRESS p, int e) {
+ return static_cast<My_Progress*>(p)->Fl_Progress::handle(e);
+}
+
+
diff --git a/body/c_fl_progress.h b/body/c_fl_progress.h
new file mode 100644
index 0000000..d75e136
--- /dev/null
+++ b/body/c_fl_progress.h
@@ -0,0 +1,32 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_PROGRESS_GUARD
+#define FL_PROGRESS_GUARD
+
+
+typedef void* PROGRESS;
+
+
+extern "C" PROGRESS new_fl_progress(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_progress(PROGRESS p);
+
+
+extern "C" float fl_progress_get_minimum(PROGRESS p);
+extern "C" void fl_progress_set_minimum(PROGRESS p, float t);
+extern "C" float fl_progress_get_maximum(PROGRESS p);
+extern "C" void fl_progress_set_maximum(PROGRESS p, float t);
+extern "C" float fl_progress_get_value(PROGRESS p);
+extern "C" void fl_progress_set_value(PROGRESS p, float t);
+
+
+extern "C" void fl_progress_draw(PROGRESS p);
+extern "C" int fl_progress_handle(PROGRESS p, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_radio_button.cpp b/body/c_fl_radio_button.cpp
new file mode 100644
index 0000000..486c354
--- /dev/null
+++ b/body/c_fl_radio_button.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Radio_Button.H>
+#include "c_fl_radio_button.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Radio_Button : public Fl_Radio_Button {
+public:
+ using Fl_Radio_Button::Fl_Radio_Button;
+
+ friend void fl_radio_button_draw(RADIOBUTTON b);
+ friend int fl_radio_button_handle(RADIOBUTTON b, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Radio_Button::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Radio_Button::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+RADIOBUTTON new_fl_radio_button(int x, int y, int w, int h, char* label) {
+ My_Radio_Button *b = new My_Radio_Button(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_radio_button(RADIOBUTTON b) {
+ delete static_cast<My_Radio_Button*>(b);
+}
+
+
+
+
+void fl_radio_button_draw(RADIOBUTTON b) {
+ static_cast<My_Radio_Button*>(b)->Fl_Radio_Button::draw();
+}
+
+int fl_radio_button_handle(RADIOBUTTON b, int e) {
+ return static_cast<My_Radio_Button*>(b)->Fl_Radio_Button::handle(e);
+}
+
+
diff --git a/body/c_fl_radio_button.h b/body/c_fl_radio_button.h
new file mode 100644
index 0000000..53bdd57
--- /dev/null
+++ b/body/c_fl_radio_button.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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);
+
+
+extern "C" void fl_radio_button_draw(RADIOBUTTON b);
+extern "C" int fl_radio_button_handle(RADIOBUTTON b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_radio_light_button.cpp b/body/c_fl_radio_light_button.cpp
new file mode 100644
index 0000000..f6da99e
--- /dev/null
+++ b/body/c_fl_radio_light_button.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Radio_Light_Button.H>
+#include "c_fl_radio_light_button.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Radio_Light_Button : public Fl_Radio_Light_Button {
+public:
+ using Fl_Radio_Light_Button::Fl_Radio_Light_Button;
+
+ friend void fl_radio_light_button_draw(RADIOLIGHTBUTTON b);
+ friend int fl_radio_light_button_handle(RADIOLIGHTBUTTON b, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Radio_Light_Button::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Radio_Light_Button::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+RADIOLIGHTBUTTON new_fl_radio_light_button(int x, int y, int w, int h, char* label) {
+ My_Radio_Light_Button *b = new My_Radio_Light_Button(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_radio_light_button(RADIOLIGHTBUTTON b) {
+ delete static_cast<My_Radio_Light_Button*>(b);
+}
+
+
+
+
+void fl_radio_light_button_draw(RADIOLIGHTBUTTON b) {
+ static_cast<My_Radio_Light_Button*>(b)->Fl_Radio_Light_Button::draw();
+}
+
+int fl_radio_light_button_handle(RADIOLIGHTBUTTON b, int e) {
+ return static_cast<My_Radio_Light_Button*>(b)->Fl_Radio_Light_Button::handle(e);
+}
+
+
diff --git a/body/c_fl_radio_light_button.h b/body/c_fl_radio_light_button.h
new file mode 100644
index 0000000..217bd69
--- /dev/null
+++ b/body/c_fl_radio_light_button.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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);
+
+
+extern "C" void fl_radio_light_button_draw(RADIOLIGHTBUTTON b);
+extern "C" int fl_radio_light_button_handle(RADIOLIGHTBUTTON b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_radio_round_button.cpp b/body/c_fl_radio_round_button.cpp
new file mode 100644
index 0000000..b09e1f3
--- /dev/null
+++ b/body/c_fl_radio_round_button.cpp
@@ -0,0 +1,68 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Radio_Round_Button.H>
+#include "c_fl_radio_round_button.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Radio_Round_Button : public Fl_Radio_Round_Button {
+public:
+ using Fl_Radio_Round_Button::Fl_Radio_Round_Button;
+
+ friend void fl_radio_round_button_draw(RADIOROUNDBUTTON b);
+ friend int fl_radio_round_button_handle(RADIOROUNDBUTTON b, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Radio_Round_Button::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Radio_Round_Button::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+RADIOROUNDBUTTON new_fl_radio_round_button(int x, int y, int w, int h, char* label) {
+ My_Radio_Round_Button *b = new My_Radio_Round_Button(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_radio_round_button(RADIOROUNDBUTTON b) {
+ delete static_cast<My_Radio_Round_Button*>(b);
+}
+
+
+
+
+
+void fl_radio_round_button_draw(RADIOROUNDBUTTON b) {
+ static_cast<My_Radio_Round_Button*>(b)->Fl_Radio_Round_Button::draw();
+}
+
+int fl_radio_round_button_handle(RADIOROUNDBUTTON b, int e) {
+ return static_cast<My_Radio_Round_Button*>(b)->Fl_Radio_Round_Button::handle(e);
+}
+
+
diff --git a/body/c_fl_radio_round_button.h b/body/c_fl_radio_round_button.h
new file mode 100644
index 0000000..bea7076
--- /dev/null
+++ b/body/c_fl_radio_round_button.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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);
+
+
+extern "C" void fl_radio_round_button_draw(RADIOROUNDBUTTON b);
+extern "C" int fl_radio_round_button_handle(RADIOROUNDBUTTON b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_repeat_button.cpp b/body/c_fl_repeat_button.cpp
new file mode 100644
index 0000000..c3eb582
--- /dev/null
+++ b/body/c_fl_repeat_button.cpp
@@ -0,0 +1,74 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Repeat_Button.H>
+#include "c_fl_repeat_button.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Repeat_Button : public Fl_Repeat_Button {
+public:
+ using Fl_Repeat_Button::Fl_Repeat_Button;
+
+ friend void fl_repeat_button_draw(REPEATBUTTON b);
+ friend int fl_repeat_button_handle(REPEATBUTTON b, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Repeat_Button::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Repeat_Button::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+REPEATBUTTON new_fl_repeat_button(int x, int y, int w, int h, char* label) {
+ My_Repeat_Button *b = new My_Repeat_Button(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_repeat_button(REPEATBUTTON b) {
+ delete static_cast<My_Repeat_Button*>(b);
+}
+
+
+
+
+void fl_repeat_button_deactivate(REPEATBUTTON b) {
+ static_cast<Fl_Repeat_Button*>(b)->deactivate();
+}
+
+
+
+
+void fl_repeat_button_draw(REPEATBUTTON b) {
+ static_cast<My_Repeat_Button*>(b)->Fl_Repeat_Button::draw();
+}
+
+int fl_repeat_button_handle(REPEATBUTTON b, int e) {
+ return static_cast<My_Repeat_Button*>(b)->Fl_Repeat_Button::handle(e);
+}
+
+
diff --git a/body/c_fl_repeat_button.h b/body/c_fl_repeat_button.h
new file mode 100644
index 0000000..5750a60
--- /dev/null
+++ b/body/c_fl_repeat_button.h
@@ -0,0 +1,27 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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);
+
+
+extern "C" void fl_repeat_button_deactivate(REPEATBUTTON b);
+
+
+extern "C" void fl_repeat_button_draw(REPEATBUTTON b);
+extern "C" int fl_repeat_button_handle(REPEATBUTTON b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_return_button.cpp b/body/c_fl_return_button.cpp
new file mode 100644
index 0000000..2c315d1
--- /dev/null
+++ b/body/c_fl_return_button.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Return_Button.H>
+#include "c_fl_return_button.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Return_Button : public Fl_Return_Button {
+public:
+ using Fl_Return_Button::Fl_Return_Button;
+
+ friend void fl_return_button_draw(RETURNBUTTON b);
+ friend int fl_return_button_handle(RETURNBUTTON b, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Return_Button::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Return_Button::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+RETURNBUTTON new_fl_return_button(int x, int y, int w, int h, char* label) {
+ My_Return_Button *b = new My_Return_Button(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_return_button(RETURNBUTTON b) {
+ delete static_cast<My_Return_Button*>(b);
+}
+
+
+
+
+void fl_return_button_draw(RETURNBUTTON b) {
+ static_cast<My_Return_Button*>(b)->Fl_Return_Button::draw();
+}
+
+int fl_return_button_handle(RETURNBUTTON b, int e) {
+ return static_cast<My_Return_Button*>(b)->Fl_Return_Button::handle(e);
+}
+
+
diff --git a/body/c_fl_return_button.h b/body/c_fl_return_button.h
new file mode 100644
index 0000000..c9f4d62
--- /dev/null
+++ b/body/c_fl_return_button.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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);
+
+
+extern "C" void fl_return_button_draw(RETURNBUTTON b);
+extern "C" int fl_return_button_handle(RETURNBUTTON b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_rgb_image.cpp b/body/c_fl_rgb_image.cpp
new file mode 100644
index 0000000..65afbf9
--- /dev/null
+++ b/body/c_fl_rgb_image.cpp
@@ -0,0 +1,78 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_RGB_Image.H>
+#include <FL/Fl_Pixmap.H>
+#include "c_fl_rgb_image.h"
+
+
+
+
+RGBIMAGE new_fl_rgb_image(void *data, int w, int h, int d, int ld) {
+ Fl_RGB_Image *rgb = new Fl_RGB_Image(static_cast<uchar*>(data), w, h, d, ld);
+ return rgb;
+}
+
+RGBIMAGE new_fl_rgb_image2(void *pix, unsigned int c) {
+ Fl_RGB_Image *rgb = new Fl_RGB_Image(static_cast<Fl_Pixmap*>(pix), c);
+ return rgb;
+}
+
+void free_fl_rgb_image(RGBIMAGE i) {
+ delete static_cast<Fl_RGB_Image*>(i);
+}
+
+size_t fl_rgb_image_get_max_size() {
+ return Fl_RGB_Image::max_size();
+}
+
+void fl_rgb_image_set_max_size(size_t v) {
+ Fl_RGB_Image::max_size(v);
+}
+
+RGBIMAGE fl_rgb_image_copy(RGBIMAGE i, int w, int h) {
+ // virtual so disable dispatch
+ return static_cast<Fl_RGB_Image*>(i)->Fl_RGB_Image::copy(w, h);
+}
+
+RGBIMAGE fl_rgb_image_copy2(RGBIMAGE i) {
+ return static_cast<Fl_RGB_Image*>(i)->copy();
+}
+
+
+
+
+void fl_rgb_image_color_average(RGBIMAGE i, int c, float b) {
+ // virtual so disable dispatch
+ static_cast<Fl_RGB_Image*>(i)->Fl_RGB_Image::color_average(c, b);
+}
+
+void fl_rgb_image_desaturate(RGBIMAGE i) {
+ // virtual so disable dispatch
+ static_cast<Fl_RGB_Image*>(i)->Fl_RGB_Image::desaturate();
+}
+
+
+
+
+void fl_rgb_image_uncache(RGBIMAGE i) {
+ // virtual so disable dispatch
+ static_cast<Fl_RGB_Image*>(i)->Fl_RGB_Image::uncache();
+}
+
+
+
+
+void fl_rgb_image_draw2(RGBIMAGE i, int x, int y) {
+ static_cast<Fl_RGB_Image*>(i)->draw(x, y);
+}
+
+void fl_rgb_image_draw(RGBIMAGE i, int x, int y, int w, int h, int cx, int cy) {
+ // virtual so disable dispatch
+ static_cast<Fl_RGB_Image*>(i)->Fl_RGB_Image::draw(x, y, w, h, cx, cy);
+}
+
+
diff --git a/body/c_fl_rgb_image.h b/body/c_fl_rgb_image.h
new file mode 100644
index 0000000..a09b58e
--- /dev/null
+++ b/body/c_fl_rgb_image.h
@@ -0,0 +1,36 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_RGB_IMAGE_GUARD
+#define FL_RGB_IMAGE_GUARD
+
+
+typedef void* RGBIMAGE;
+
+
+extern "C" RGBIMAGE new_fl_rgb_image(void *data, int w, int h, int d, int ld);
+extern "C" RGBIMAGE new_fl_rgb_image2(void *pix, unsigned int c);
+extern "C" void free_fl_rgb_image(RGBIMAGE i);
+extern "C" size_t fl_rgb_image_get_max_size();
+extern "C" void fl_rgb_image_set_max_size(size_t v);
+extern "C" RGBIMAGE fl_rgb_image_copy(RGBIMAGE i, int w, int h);
+extern "C" RGBIMAGE fl_rgb_image_copy2(RGBIMAGE i);
+
+
+extern "C" void fl_rgb_image_color_average(RGBIMAGE i, int c, float b);
+extern "C" void fl_rgb_image_desaturate(RGBIMAGE i);
+
+
+extern "C" void fl_rgb_image_uncache(RGBIMAGE i);
+
+
+extern "C" void fl_rgb_image_draw2(RGBIMAGE i, int x, int y);
+extern "C" void fl_rgb_image_draw(RGBIMAGE i, int x, int y, int w, int h, int cx, int cy);
+
+
+#endif
+
+
diff --git a/body/c_fl_roller.cpp b/body/c_fl_roller.cpp
new file mode 100644
index 0000000..1c65422
--- /dev/null
+++ b/body/c_fl_roller.cpp
@@ -0,0 +1,74 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Roller.H>
+#include "c_fl_roller.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Roller : public Fl_Roller {
+public:
+ using Fl_Roller::Fl_Roller;
+
+ friend void fl_roller_draw(ROLLER r);
+ friend int fl_roller_handle(ROLLER r, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Roller::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Roller::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Roller::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+ROLLER new_fl_roller(int x, int y, int w, int h, char* label) {
+ My_Roller *r = new My_Roller(x, y, w, h, label);
+ return r;
+}
+
+void free_fl_roller(ROLLER r) {
+ delete static_cast<My_Roller*>(r);
+}
+
+
+
+
+void fl_roller_draw(ROLLER r) {
+ static_cast<My_Roller*>(r)->Fl_Roller::draw();
+}
+
+int fl_roller_handle(ROLLER r, int e) {
+ return static_cast<My_Roller*>(r)->Fl_Roller::handle(e);
+}
+
+
diff --git a/body/c_fl_roller.h b/body/c_fl_roller.h
new file mode 100644
index 0000000..a864d71
--- /dev/null
+++ b/body/c_fl_roller.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_ROLLER_GUARD
+#define FL_ROLLER_GUARD
+
+
+typedef void* ROLLER;
+
+
+extern "C" ROLLER new_fl_roller(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_roller(ROLLER r);
+
+
+extern "C" void fl_roller_draw(ROLLER r);
+extern "C" int fl_roller_handle(ROLLER r, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_round_button.cpp b/body/c_fl_round_button.cpp
new file mode 100644
index 0000000..e6a9c43
--- /dev/null
+++ b/body/c_fl_round_button.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Round_Button.H>
+#include "c_fl_round_button.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Round_Button : public Fl_Round_Button {
+public:
+ using Fl_Round_Button::Fl_Round_Button;
+
+ friend void fl_round_button_draw(ROUNDBUTTON b);
+ friend int fl_round_button_handle(ROUNDBUTTON b, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Round_Button::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Round_Button::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+ROUNDBUTTON new_fl_round_button(int x, int y, int w, int h, char* label) {
+ My_Round_Button *b = new My_Round_Button(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_round_button(ROUNDBUTTON b) {
+ delete static_cast<My_Round_Button*>(b);
+}
+
+
+
+
+void fl_round_button_draw(ROUNDBUTTON b) {
+ static_cast<My_Round_Button*>(b)->Fl_Round_Button::draw();
+}
+
+int fl_round_button_handle(ROUNDBUTTON b, int e) {
+ return static_cast<My_Round_Button*>(b)->Fl_Round_Button::handle(e);
+}
+
+
diff --git a/body/c_fl_round_button.h b/body/c_fl_round_button.h
new file mode 100644
index 0000000..cbbaf9f
--- /dev/null
+++ b/body/c_fl_round_button.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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);
+
+
+extern "C" void fl_round_button_draw(ROUNDBUTTON b);
+extern "C" int fl_round_button_handle(ROUNDBUTTON b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_round_clock.cpp b/body/c_fl_round_clock.cpp
new file mode 100644
index 0000000..0036c00
--- /dev/null
+++ b/body/c_fl_round_clock.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Round_Clock.H>
+#include "c_fl_round_clock.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Round_Clock : public Fl_Round_Clock {
+public:
+ using Fl_Round_Clock::Fl_Round_Clock;
+
+ friend void fl_round_clock_draw(ROUNDCLOCK c);
+ friend int fl_round_clock_handle(ROUNDCLOCK c, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Round_Clock::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Round_Clock::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+ROUNDCLOCK new_fl_round_clock(int x, int y, int w, int h, char* label) {
+ My_Round_Clock *c = new My_Round_Clock(x, y, w, h, label);
+ return c;
+}
+
+void free_fl_round_clock(ROUNDCLOCK c) {
+ delete static_cast<My_Round_Clock*>(c);
+}
+
+
+
+
+void fl_round_clock_draw(ROUNDCLOCK c) {
+ static_cast<My_Round_Clock*>(c)->Fl_Round_Clock::draw();
+}
+
+int fl_round_clock_handle(ROUNDCLOCK c, int e) {
+ return static_cast<My_Round_Clock*>(c)->Fl_Round_Clock::handle(e);
+}
+
+
diff --git a/body/c_fl_round_clock.h b/body/c_fl_round_clock.h
new file mode 100644
index 0000000..475a5d0
--- /dev/null
+++ b/body/c_fl_round_clock.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_ROUND_CLOCK_GUARD
+#define FL_ROUND_CLOCK_GUARD
+
+
+typedef void* ROUNDCLOCK;
+
+
+extern "C" ROUNDCLOCK new_fl_round_clock(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_round_clock(ROUNDCLOCK c);
+
+
+extern "C" void fl_round_clock_draw(ROUNDCLOCK c);
+extern "C" int fl_round_clock_handle(ROUNDCLOCK c, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_screen.cpp b/body/c_fl_screen.cpp
new file mode 100644
index 0000000..88550bd
--- /dev/null
+++ b/body/c_fl_screen.cpp
@@ -0,0 +1,84 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl.H>
+#include "c_fl_screen.h"
+
+
+int fl_screen_x() {
+ return Fl::x();
+}
+
+int fl_screen_y() {
+ return Fl::y();
+}
+
+int fl_screen_w() {
+ return Fl::w();
+}
+
+int fl_screen_h() {
+ return Fl::h();
+}
+
+
+
+
+int fl_screen_count() {
+ return Fl::screen_count();
+}
+
+void fl_screen_dpi(float &h, float &v, int n) {
+ Fl::screen_dpi(h, v, n);
+}
+
+
+
+
+int fl_screen_num(int x, int y) {
+ return Fl::screen_num(x, y);
+}
+
+
+int fl_screen_num2(int x, int y, int w, int h) {
+ return Fl::screen_num(x, y, w, h);
+}
+
+
+
+
+void fl_screen_work_area(int &x, int &y, int &w, int &h, int px, int py) {
+ Fl::screen_work_area(x, y, w, h, px, py);
+}
+
+void fl_screen_work_area2(int &x, int &y, int &w, int &h, int n) {
+ Fl::screen_work_area(x, y, w, h, n);
+}
+
+void fl_screen_work_area3(int &x, int &y, int &w, int &h) {
+ Fl::screen_work_area(x, y, w, h);
+}
+
+
+
+
+void fl_screen_xywh(int &x, int &y, int &w, int &h, int px, int py) {
+ Fl::screen_xywh(x, y, w, h, px, py);
+}
+
+void fl_screen_xywh2(int &x, int &y, int &w, int &h, int n) {
+ Fl::screen_xywh(x, y, w, h, n);
+}
+
+void fl_screen_xywh3(int &x, int &y, int &w, int &h) {
+ Fl::screen_xywh(x, y, w, h);
+}
+
+void fl_screen_xywh4(int &x, int &y, int &w, int &h, int px, int py, int pw, int ph) {
+ Fl::screen_xywh(x, y, w, h, px, py, pw, ph);
+}
+
+
diff --git a/body/c_fl_screen.h b/body/c_fl_screen.h
new file mode 100644
index 0000000..9b4d4ec
--- /dev/null
+++ b/body/c_fl_screen.h
@@ -0,0 +1,38 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SCREEN_GUARD
+#define FL_SCREEN_GUARD
+
+
+extern "C" int fl_screen_x();
+extern "C" int fl_screen_y();
+extern "C" int fl_screen_w();
+extern "C" int fl_screen_h();
+
+
+extern "C" int fl_screen_count();
+extern "C" void fl_screen_dpi(float &h, float &v, int n);
+
+
+extern "C" int fl_screen_num(int x, int y);
+extern "C" int fl_screen_num2(int x, int y, int w, int h);
+
+
+extern "C" void fl_screen_work_area(int &x, int &y, int &w, int &h, int px, int py);
+extern "C" void fl_screen_work_area2(int &x, int &y, int &w, int &h, int n);
+extern "C" void fl_screen_work_area3(int &x, int &y, int &w, int &h);
+
+
+extern "C" void fl_screen_xywh(int &x, int &y, int &w, int &h, int px, int py);
+extern "C" void fl_screen_xywh2(int &x, int &y, int &w, int &h, int n);
+extern "C" void fl_screen_xywh3(int &x, int &y, int &w, int &h);
+extern "C" void fl_screen_xywh4(int &x, int &y, int &w, int &h, int px, int py, int pw, int ph);
+
+
+#endif
+
+
diff --git a/body/c_fl_scroll.cpp b/body/c_fl_scroll.cpp
new file mode 100644
index 0000000..5fd3240
--- /dev/null
+++ b/body/c_fl_scroll.cpp
@@ -0,0 +1,104 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Scroll.H>
+#include "c_fl_scroll.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Scroll : public Fl_Scroll {
+public:
+ using Fl_Scroll::Fl_Scroll;
+
+ friend void fl_scroll_draw(SCROLL s);
+ friend int fl_scroll_handle(SCROLL s, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Scroll::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Scroll::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+SCROLL new_fl_scroll(int x, int y, int w, int h, char* label) {
+ My_Scroll *s = new My_Scroll(x, y, w, h, label);
+ return s;
+}
+
+void free_fl_scroll(SCROLL s) {
+ delete static_cast<My_Scroll*>(s);
+}
+
+
+
+
+void * fl_scroll_hscrollbar(SCROLL s) {
+ return &static_cast<Fl_Scroll*>(s)->hscrollbar;
+}
+
+void * fl_scroll_scrollbar(SCROLL s) {
+ return &static_cast<Fl_Scroll*>(s)->scrollbar;
+}
+
+
+
+
+void fl_scroll_to(SCROLL s, int x, int y) {
+ static_cast<Fl_Scroll*>(s)->scroll_to(x, y);
+}
+
+int fl_scroll_xposition(SCROLL s) {
+ return static_cast<Fl_Scroll*>(s)->xposition();
+}
+
+int fl_scroll_yposition(SCROLL s) {
+ return static_cast<Fl_Scroll*>(s)->yposition();
+}
+
+
+
+
+int fl_scroll_get_size(SCROLL s) {
+ return static_cast<Fl_Scroll*>(s)->scrollbar_size();
+}
+
+void fl_scroll_set_size(SCROLL s, int t) {
+ static_cast<Fl_Scroll*>(s)->scrollbar_size(t);
+}
+
+
+
+
+void fl_scroll_draw(SCROLL s) {
+ static_cast<My_Scroll*>(s)->Fl_Scroll::draw();
+}
+
+int fl_scroll_handle(SCROLL s, int e) {
+ return static_cast<My_Scroll*>(s)->Fl_Scroll::handle(e);
+}
+
+
diff --git a/body/c_fl_scroll.h b/body/c_fl_scroll.h
new file mode 100644
index 0000000..fe8674e
--- /dev/null
+++ b/body/c_fl_scroll.h
@@ -0,0 +1,37 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SCROLL_GUARD
+#define FL_SCROLL_GUARD
+
+
+typedef void* SCROLL;
+
+
+extern "C" SCROLL new_fl_scroll(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_scroll(SCROLL s);
+
+
+extern "C" void * fl_scroll_hscrollbar(SCROLL s);
+extern "C" void * fl_scroll_scrollbar(SCROLL s);
+
+
+extern "C" void fl_scroll_to(SCROLL s, int x, int y);
+extern "C" int fl_scroll_xposition(SCROLL s);
+extern "C" int fl_scroll_yposition(SCROLL s);
+
+
+extern "C" int fl_scroll_get_size(SCROLL s);
+extern "C" void fl_scroll_set_size(SCROLL s, int t);
+
+
+extern "C" void fl_scroll_draw(SCROLL s);
+extern "C" int fl_scroll_handle(SCROLL s, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_scrollbar.cpp b/body/c_fl_scrollbar.cpp
new file mode 100644
index 0000000..2ebdb27
--- /dev/null
+++ b/body/c_fl_scrollbar.cpp
@@ -0,0 +1,112 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Scrollbar.H>
+#include "c_fl_scrollbar.h"
+
+
+
+
+// Telprot stopovers
+
+extern "C" void scrollbar_extra_init_hook(void * aobj, int x, int y, int w, int h, const char * l);
+void fl_scrollbar_extra_init (void * adaobj, int x, int y, int w, int h, const char * label) {
+ scrollbar_extra_init_hook(adaobj, x, y, w, h, label);
+}
+
+extern "C" void scrollbar_extra_final_hook(void * aobj);
+void fl_scrollbar_extra_final(void * adaobj) {
+ scrollbar_extra_final_hook(adaobj);
+}
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Scrollbar : public Fl_Scrollbar {
+public:
+ using Fl_Scrollbar::Fl_Scrollbar;
+
+ friend void fl_scrollbar_draw(SCROLLBAR s);
+ friend int fl_scrollbar_handle(SCROLLBAR s, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Scrollbar::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Scrollbar::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Scrollbar::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+SCROLLBAR new_fl_scrollbar(int x, int y, int w, int h, char* label) {
+ My_Scrollbar *s = new My_Scrollbar(x, y, w, h, label);
+ return s;
+}
+
+void free_fl_scrollbar(SCROLLBAR s) {
+ delete static_cast<My_Scrollbar*>(s);
+}
+
+
+
+
+int fl_scrollbar_get_linesize(SCROLLBAR s) {
+ return static_cast<Fl_Scrollbar*>(s)->linesize();
+}
+
+void fl_scrollbar_set_linesize(SCROLLBAR s, int t) {
+ static_cast<Fl_Scrollbar*>(s)->linesize(t);
+}
+
+int fl_scrollbar_get_value(SCROLLBAR s) {
+ return static_cast<Fl_Scrollbar*>(s)->value();
+}
+
+void fl_scrollbar_set_value(SCROLLBAR s, int t) {
+ static_cast<Fl_Scrollbar*>(s)->value(t);
+}
+
+void fl_scrollbar_set_value2(SCROLLBAR s, int p, int w, int f, int t) {
+ static_cast<Fl_Scrollbar*>(s)->value(p,w,f,t);
+}
+
+
+
+
+void fl_scrollbar_draw(SCROLLBAR s) {
+ static_cast<My_Scrollbar*>(s)->Fl_Scrollbar::draw();
+}
+
+int fl_scrollbar_handle(SCROLLBAR s, int e) {
+ return static_cast<My_Scrollbar*>(s)->Fl_Scrollbar::handle(e);
+}
+
+
diff --git a/body/c_fl_scrollbar.h b/body/c_fl_scrollbar.h
new file mode 100644
index 0000000..870f256
--- /dev/null
+++ b/body/c_fl_scrollbar.h
@@ -0,0 +1,36 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SCROLLBAR_GUARD
+#define FL_SCROLLBAR_GUARD
+
+
+extern "C" void fl_scrollbar_extra_init
+ (void * adaobj, int x, int y, int w, int h, const char * label);
+extern "C" void fl_scrollbar_extra_final(void * adaobj);
+
+
+typedef void* SCROLLBAR;
+
+
+extern "C" SCROLLBAR new_fl_scrollbar(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_scrollbar(SCROLLBAR s);
+
+
+extern "C" int fl_scrollbar_get_linesize(SCROLLBAR s);
+extern "C" void fl_scrollbar_set_linesize(SCROLLBAR s, int t);
+extern "C" int fl_scrollbar_get_value(SCROLLBAR s);
+extern "C" void fl_scrollbar_set_value(SCROLLBAR s, int t);
+extern "C" void fl_scrollbar_set_value2(SCROLLBAR s, int p, int w, int f, int t);
+
+
+extern "C" void fl_scrollbar_draw(SCROLLBAR s);
+extern "C" int fl_scrollbar_handle(SCROLLBAR s, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_secret_input.cpp b/body/c_fl_secret_input.cpp
new file mode 100644
index 0000000..b3205cb
--- /dev/null
+++ b/body/c_fl_secret_input.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Secret_Input.H>
+#include "c_fl_secret_input.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Secret_Input : public Fl_Secret_Input {
+public:
+ using Fl_Secret_Input::Fl_Secret_Input;
+
+ friend void fl_secret_input_draw(SECRETINPUT i);
+ friend int fl_secret_input_handle(SECRETINPUT i, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Secret_Input::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Secret_Input::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+SECRETINPUT new_fl_secret_input(int x, int y, int w, int h, char* label) {
+ My_Secret_Input *i = new My_Secret_Input(x, y, w, h, label);
+ return i;
+}
+
+void free_fl_secret_input(SECRETINPUT i) {
+ delete static_cast<My_Secret_Input*>(i);
+}
+
+
+
+
+void fl_secret_input_draw(SECRETINPUT i) {
+ static_cast<My_Secret_Input*>(i)->Fl_Secret_Input::draw();
+}
+
+int fl_secret_input_handle(SECRETINPUT i, int e) {
+ return static_cast<My_Secret_Input*>(i)->Fl_Secret_Input::handle(e);
+}
+
+
diff --git a/body/c_fl_secret_input.h b/body/c_fl_secret_input.h
new file mode 100644
index 0000000..ea171d8
--- /dev/null
+++ b/body/c_fl_secret_input.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SECRET_INPUT_GUARD
+#define FL_SECRET_INPUT_GUARD
+
+
+typedef void* SECRETINPUT;
+
+
+extern "C" SECRETINPUT new_fl_secret_input(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_secret_input(SECRETINPUT i);
+
+
+extern "C" void fl_secret_input_draw(SECRETINPUT i);
+extern "C" int fl_secret_input_handle(SECRETINPUT i, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_select_browser.cpp b/body/c_fl_select_browser.cpp
new file mode 100644
index 0000000..5993703
--- /dev/null
+++ b/body/c_fl_select_browser.cpp
@@ -0,0 +1,264 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Select_Browser.H>
+#include "c_fl_select_browser.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" int browser_full_width_hook(void * b);
+extern "C" int browser_full_height_hook(void * b);
+extern "C" int browser_incr_height_hook(void * b);
+extern "C" int browser_item_quick_height_hook(void * b, void * i);
+
+extern "C" int browser_item_width_hook(void * b, void * i);
+extern "C" int browser_item_height_hook(void * b, void * i);
+extern "C" void * browser_item_first_hook(void * b);
+extern "C" void * browser_item_last_hook(void * b);
+extern "C" void * browser_item_next_hook(void * b, void * i);
+extern "C" void * browser_item_prev_hook(void * b, void * i);
+extern "C" void * browser_item_at_hook(void * b, int n);
+extern "C" void browser_item_select_hook(void * b, void * i, int s);
+extern "C" int browser_item_selected_hook(void * b, void * i);
+extern "C" void browser_item_swap_hook(void * b, void * one, void * two);
+extern "C" const char * browser_item_text_hook(void * b, void * i);
+extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h);
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Select_Browser : public Fl_Select_Browser {
+public:
+ using Fl_Select_Browser::Fl_Select_Browser;
+
+ friend int fl_select_browser_item_width(SELECTBROWSER b, void * item);
+ friend int fl_select_browser_item_height(SELECTBROWSER b, void * item);
+ friend void * fl_select_browser_item_first(SELECTBROWSER b);
+ friend void * fl_select_browser_item_last(SELECTBROWSER b);
+ friend void * fl_select_browser_item_next(SELECTBROWSER b, void * item);
+ friend void * fl_select_browser_item_prev(SELECTBROWSER b, void * item);
+ friend void * fl_select_browser_item_at(SELECTBROWSER b, int index);
+ friend void fl_select_browser_item_select(SELECTBROWSER b, void * item, int val);
+ friend int fl_select_browser_item_selected(SELECTBROWSER b, void * item);
+ friend void fl_select_browser_item_swap(SELECTBROWSER b, void * x, void * y);
+ friend const char * fl_select_browser_item_text(SELECTBROWSER b, void * item);
+ friend void fl_select_browser_item_draw(SELECTBROWSER b, void * item, int x, int y, int w, int h);
+
+ friend int fl_select_browser_full_width(SELECTBROWSER c);
+ friend int fl_select_browser_full_height(SELECTBROWSER c);
+ friend int fl_select_browser_incr_height(SELECTBROWSER c);
+ friend int fl_select_browser_item_quick_height(SELECTBROWSER c, void * i);
+
+ friend void fl_select_browser_draw(SELECTBROWSER b);
+
+ int handle(int e);
+
+protected:
+ int full_width() const;
+ int full_height() const;
+ int incr_height() const;
+ int item_quick_height(void * item) const;
+
+ int item_width(void * item) const;
+ int item_height(void * item) const;
+ void * item_first() const;
+ void * item_last() const;
+ void * item_next(void * item) const;
+ void * item_prev(void * item) const;
+ void * item_at(int index) const;
+ void item_select(void * item, int val=1);
+ int item_selected(void * item) const;
+ void item_swap(void * a, void * b);
+ const char * item_text(void * item) const;
+ void item_draw(void * item, int x, int y, int w, int h) const;
+
+ void draw();
+};
+
+
+int My_Select_Browser::full_width() const {
+ return browser_full_width_hook(this->user_data());
+}
+
+int My_Select_Browser::full_height() const {
+ return browser_full_height_hook(this->user_data());
+}
+
+int My_Select_Browser::incr_height() const {
+ return browser_incr_height_hook(this->user_data());
+}
+
+int My_Select_Browser::item_quick_height(void * item) const {
+ return browser_item_quick_height_hook(this->user_data(), item);
+}
+
+
+int My_Select_Browser::item_width(void * item) const {
+ return browser_item_width_hook(this->user_data(), item);
+}
+
+int My_Select_Browser::item_height(void * item) const {
+ return browser_item_height_hook(this->user_data(), item);
+}
+
+void * My_Select_Browser::item_first() const {
+ return browser_item_first_hook(this->user_data());
+}
+
+void * My_Select_Browser::item_last() const {
+ return browser_item_last_hook(this->user_data());
+}
+
+void * My_Select_Browser::item_next(void * item) const {
+ return browser_item_next_hook(this->user_data(), item);
+}
+
+void * My_Select_Browser::item_prev(void * item) const {
+ return browser_item_prev_hook(this->user_data(), item);
+}
+
+void * My_Select_Browser::item_at(int index) const {
+ return browser_item_at_hook(this->user_data(), index);
+}
+
+void My_Select_Browser::item_select(void * item, int val) {
+ browser_item_select_hook(this->user_data(), item, val);
+}
+
+int My_Select_Browser::item_selected(void * item) const {
+ return browser_item_selected_hook(this->user_data(), item);
+}
+
+void My_Select_Browser::item_swap(void * a, void * b) {
+ browser_item_swap_hook(this->user_data(), a, b);
+}
+
+const char * My_Select_Browser::item_text(void * item) const {
+ return browser_item_text_hook(this->user_data(), item);
+}
+
+void My_Select_Browser::item_draw(void * item, int x, int y, int w, int h) const {
+ browser_item_draw_hook(this->user_data(), item, x, y, w, h);
+}
+
+
+void My_Select_Browser::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Select_Browser::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API begins here
+
+SELECTBROWSER new_fl_select_browser(int x, int y, int w, int h, char * label) {
+ My_Select_Browser *b = new My_Select_Browser(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_select_browser(SELECTBROWSER b) {
+ delete static_cast<My_Select_Browser*>(b);
+}
+
+
+
+
+// These have to be reimplemented due to relying on custom class extensions
+
+int fl_select_browser_full_height(SELECTBROWSER c) {
+ return static_cast<My_Select_Browser*>(c)->Fl_Select_Browser::full_height();
+}
+
+int fl_select_browser_incr_height(SELECTBROWSER c) {
+ return static_cast<My_Select_Browser*>(c)->Fl_Select_Browser::incr_height();
+}
+
+
+
+
+int fl_select_browser_item_width(SELECTBROWSER b, void * item) {
+ return static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_width(item);
+}
+
+int fl_select_browser_item_height(SELECTBROWSER b, void * item) {
+ return static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_height(item);
+}
+
+void * fl_select_browser_item_first(SELECTBROWSER b) {
+ return static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_first();
+}
+
+void * fl_select_browser_item_last(SELECTBROWSER b) {
+ return static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_last();
+}
+
+void * fl_select_browser_item_next(SELECTBROWSER b, void * item) {
+ return static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_next(item);
+}
+
+void * fl_select_browser_item_prev(SELECTBROWSER b, void * item) {
+ return static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_prev(item);
+}
+
+void * fl_select_browser_item_at(SELECTBROWSER b, int index) {
+ return static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_at(index);
+}
+
+void fl_select_browser_item_select(SELECTBROWSER b, void * item, int val) {
+ static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_select(item, val);
+}
+
+int fl_select_browser_item_selected(SELECTBROWSER b, void * item) {
+ return static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_selected(item);
+}
+
+void fl_select_browser_item_swap(SELECTBROWSER b, void * x, void * y) {
+ static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_swap(x, y);
+}
+
+const char * fl_select_browser_item_text(SELECTBROWSER b, void * item) {
+ return static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_text(item);
+}
+
+void fl_select_browser_item_draw(SELECTBROWSER b, void * item, int x, int y, int w, int h) {
+ static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::item_draw(item, x, y, w, h);
+}
+
+
+
+
+int fl_select_browser_full_width(SELECTBROWSER c) {
+ return static_cast<My_Select_Browser*>(c)->Fl_Select_Browser::full_width();
+}
+
+int fl_select_browser_item_quick_height(SELECTBROWSER c, void * i) {
+ return static_cast<My_Select_Browser*>(c)->Fl_Select_Browser::item_quick_height(i);
+}
+
+
+
+
+void fl_select_browser_draw(SELECTBROWSER b) {
+ static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::draw();
+}
+
+int fl_select_browser_handle(SELECTBROWSER b, int e) {
+ return static_cast<My_Select_Browser*>(b)->Fl_Select_Browser::handle(e);
+}
+
+
diff --git a/body/c_fl_select_browser.h b/body/c_fl_select_browser.h
new file mode 100644
index 0000000..f72b8de
--- /dev/null
+++ b/body/c_fl_select_browser.h
@@ -0,0 +1,48 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SELECT_BROWSER_GUARD
+#define FL_SELECT_BROWSER_GUARD
+
+
+typedef void* SELECTBROWSER;
+
+
+extern "C" SELECTBROWSER new_fl_select_browser(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_select_browser(SELECTBROWSER b);
+
+
+// reimp below here
+
+extern "C" int fl_select_browser_full_height(SELECTBROWSER c);
+extern "C" int fl_select_browser_incr_height(SELECTBROWSER c);
+
+
+extern "C" int fl_select_browser_item_width(SELECTBROWSER b, void * item);
+extern "C" int fl_select_browser_item_height(SELECTBROWSER b, void * item);
+extern "C" void * fl_select_browser_item_first(SELECTBROWSER b);
+extern "C" void * fl_select_browser_item_last(SELECTBROWSER b);
+extern "C" void * fl_select_browser_item_next(SELECTBROWSER b, void * item);
+extern "C" void * fl_select_browser_item_prev(SELECTBROWSER b, void * item);
+extern "C" void * fl_select_browser_item_at(SELECTBROWSER b, int index);
+extern "C" void fl_select_browser_item_select(SELECTBROWSER b, void * item, int val=1);
+extern "C" int fl_select_browser_item_selected(SELECTBROWSER b, void * item);
+extern "C" void fl_select_browser_item_swap(SELECTBROWSER b, void * x, void * y);
+extern "C" const char * fl_select_browser_item_text(SELECTBROWSER b, void * item);
+extern "C" void fl_select_browser_item_draw(SELECTBROWSER b, void * item, int x, int y, int w, int h);
+
+
+extern "C" int fl_select_browser_full_width(SELECTBROWSER c);
+extern "C" int fl_select_browser_item_quick_height(SELECTBROWSER c, void * i);
+
+
+extern "C" void fl_select_browser_draw(SELECTBROWSER b);
+extern "C" int fl_select_browser_handle(SELECTBROWSER b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_shared_image.cpp b/body/c_fl_shared_image.cpp
new file mode 100644
index 0000000..bb17632
--- /dev/null
+++ b/body/c_fl_shared_image.cpp
@@ -0,0 +1,100 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Shared_Image.H>
+#include <FL/Fl_RGB_Image.H>
+#include "c_fl_shared_image.h"
+
+
+
+
+SHAREDIMAGE fl_shared_image_get(const char * f, int w, int h) {
+ return Fl_Shared_Image::get(f, w, h);
+}
+
+SHAREDIMAGE fl_shared_image_get2(void * r) {
+ return Fl_Shared_Image::get(static_cast<Fl_RGB_Image*>(r), 0);
+}
+
+SHAREDIMAGE fl_shared_image_find(const char * n, int w, int h) {
+ return Fl_Shared_Image::find(n, w, h);
+}
+
+void fl_shared_image_release(SHAREDIMAGE i) {
+ static_cast<Fl_Shared_Image*>(i)->release();
+}
+
+SHAREDIMAGE fl_shared_image_copy(SHAREDIMAGE i, int w, int h) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Shared_Image*>(i)->Fl_Shared_Image::copy(w, h);
+}
+
+SHAREDIMAGE fl_shared_image_copy2(SHAREDIMAGE i) {
+ return static_cast<Fl_Shared_Image*>(i)->copy();
+}
+
+
+
+
+void fl_shared_image_color_average(SHAREDIMAGE i, int c, float b) {
+ // virtual so disable dispatch
+ static_cast<Fl_Shared_Image*>(i)->Fl_Shared_Image::color_average(c, b);
+}
+
+void fl_shared_image_desaturate(SHAREDIMAGE i) {
+ // virtual so disable dispatch
+ static_cast<Fl_Shared_Image*>(i)->Fl_Shared_Image::desaturate();
+}
+
+
+
+
+int fl_shared_image_num_images() {
+ return Fl_Shared_Image::num_images();
+}
+
+const char * fl_shared_image_name(SHAREDIMAGE i) {
+ return static_cast<Fl_Shared_Image*>(i)->name();
+}
+
+int fl_shared_image_original(SHAREDIMAGE i) {
+ return static_cast<Fl_Shared_Image*>(i)->original();
+}
+
+int fl_shared_image_refcount(SHAREDIMAGE i) {
+ return static_cast<Fl_Shared_Image*>(i)->refcount();
+}
+
+void fl_shared_image_reload(SHAREDIMAGE i) {
+ static_cast<Fl_Shared_Image*>(i)->reload();
+}
+
+void fl_shared_image_uncache(SHAREDIMAGE i) {
+ // virtual so disable dispatch
+ static_cast<Fl_Shared_Image*>(i)->uncache();
+}
+
+
+
+
+void fl_shared_image_scaling_algorithm(int v) {
+ Fl_Shared_Image::scaling_algorithm(static_cast<Fl_RGB_Scaling>(v));
+}
+
+void fl_shared_image_scale(SHAREDIMAGE i, int w, int h, int p, int e) {
+ static_cast<Fl_Shared_Image*>(i)->scale(w, h, p, e);
+}
+
+void fl_shared_image_draw(SHAREDIMAGE i, int x, int y, int w, int h, int cx, int cy) {
+ // virtual so disable dispatch
+ static_cast<Fl_Shared_Image*>(i)->Fl_Shared_Image::draw(x, y, w, h, cx, cy);
+}
+
+void fl_shared_image_draw2(SHAREDIMAGE i, int x, int y) {
+ static_cast<Fl_Shared_Image*>(i)->draw(x, y);
+}
+
+
diff --git a/body/c_fl_shared_image.h b/body/c_fl_shared_image.h
new file mode 100644
index 0000000..dbe0352
--- /dev/null
+++ b/body/c_fl_shared_image.h
@@ -0,0 +1,42 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SHARED_IMAGE_GUARD
+#define FL_SHARED_IMAGE_GUARD
+
+
+typedef void* SHAREDIMAGE;
+
+
+extern "C" SHAREDIMAGE fl_shared_image_get(const char * f, int w, int h);
+extern "C" SHAREDIMAGE fl_shared_image_get2(void * r);
+extern "C" SHAREDIMAGE fl_shared_image_find(const char * n, int w, int h);
+extern "C" void fl_shared_image_release(SHAREDIMAGE i);
+extern "C" SHAREDIMAGE fl_shared_image_copy(SHAREDIMAGE i, int w, int h);
+extern "C" SHAREDIMAGE fl_shared_image_copy2(SHAREDIMAGE i);
+
+
+extern "C" void fl_shared_image_color_average(SHAREDIMAGE i, int c, float b);
+extern "C" void fl_shared_image_desaturate(SHAREDIMAGE i);
+
+
+extern "C" int fl_shared_image_num_images();
+extern "C" const char * fl_shared_image_name(SHAREDIMAGE i);
+extern "C" int fl_shared_image_original(SHAREDIMAGE i);
+extern "C" int fl_shared_image_refcount(SHAREDIMAGE i);
+extern "C" void fl_shared_image_reload(SHAREDIMAGE i);
+extern "C" void fl_shared_image_uncache(SHAREDIMAGE i);
+
+
+extern "C" void fl_shared_image_scaling_algorithm(int v);
+extern "C" void fl_shared_image_scale(SHAREDIMAGE i, int w, int h, int p, int e);
+extern "C" void fl_shared_image_draw(SHAREDIMAGE i, int x, int y, int w, int h, int cx, int cy);
+extern "C" void fl_shared_image_draw2(SHAREDIMAGE i, int x, int y);
+
+
+#endif
+
+
diff --git a/body/c_fl_simple_counter.cpp b/body/c_fl_simple_counter.cpp
new file mode 100644
index 0000000..cf42d03
--- /dev/null
+++ b/body/c_fl_simple_counter.cpp
@@ -0,0 +1,74 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Simple_Counter.H>
+#include "c_fl_simple_counter.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Simple_Counter : public Fl_Simple_Counter {
+public:
+ using Fl_Simple_Counter::Fl_Simple_Counter;
+
+ friend void fl_simple_counter_draw(SIMPLECOUNTER c);
+ friend int fl_simple_counter_handle(SIMPLECOUNTER c, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Simple_Counter::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Simple_Counter::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Simple_Counter::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+SIMPLECOUNTER new_fl_simple_counter(int x, int y, int w, int h, char* label) {
+ My_Simple_Counter *c = new My_Simple_Counter(x, y, w, h, label);
+ return c;
+}
+
+void free_fl_simple_counter(SIMPLECOUNTER c) {
+ delete static_cast<My_Simple_Counter*>(c);
+}
+
+
+
+
+void fl_simple_counter_draw(SIMPLECOUNTER c) {
+ static_cast<My_Simple_Counter*>(c)->Fl_Simple_Counter::draw();
+}
+
+int fl_simple_counter_handle(SIMPLECOUNTER c, int e) {
+ return static_cast<My_Simple_Counter*>(c)->Fl_Simple_Counter::handle(e);
+}
+
+
diff --git a/body/c_fl_simple_counter.h b/body/c_fl_simple_counter.h
new file mode 100644
index 0000000..397b488
--- /dev/null
+++ b/body/c_fl_simple_counter.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SIMPLE_COUNTER_GUARD
+#define FL_SIMPLE_COUNTER_GUARD
+
+
+typedef void* SIMPLECOUNTER;
+
+
+extern "C" SIMPLECOUNTER new_fl_simple_counter(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_simple_counter(SIMPLECOUNTER c);
+
+
+extern "C" void fl_simple_counter_draw(SIMPLECOUNTER c);
+extern "C" int fl_simple_counter_handle(SIMPLECOUNTER c, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_single_window.cpp b/body/c_fl_single_window.cpp
new file mode 100644
index 0000000..efafdc4
--- /dev/null
+++ b/body/c_fl_single_window.cpp
@@ -0,0 +1,94 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Single_Window.H>
+#include "c_fl_single_window.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Single_Window : public Fl_Single_Window {
+public:
+ using Fl_Single_Window::Fl_Single_Window;
+
+ friend void fl_single_window_draw(SINGLEWINDOW n);
+ friend int fl_single_window_handle(SINGLEWINDOW n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Single_Window::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Single_Window::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label) {
+ My_Single_Window *sw = new My_Single_Window(x, y, w, h, label);
+ return sw;
+}
+
+SINGLEWINDOW new_fl_single_window2(int x, int y, char* label) {
+ My_Single_Window *sw = new My_Single_Window(x, y, label);
+ return sw;
+}
+
+void free_fl_single_window(SINGLEWINDOW w) {
+ delete static_cast<My_Single_Window*>(w);
+}
+
+
+
+
+void fl_single_window_show(SINGLEWINDOW w) {
+ static_cast<Fl_Single_Window*>(w)->show();
+}
+
+void fl_single_window_show2(SINGLEWINDOW w, int c, void * v) {
+ static_cast<Fl_Single_Window*>(w)->show(c, static_cast<char**>(v));
+}
+
+void fl_single_window_flush(SINGLEWINDOW w) {
+ static_cast<Fl_Single_Window*>(w)->flush();
+}
+
+
+
+
+void fl_single_window_make_current(SINGLEWINDOW w) {
+ static_cast<Fl_Single_Window*>(w)->Fl_Window::make_current();
+}
+
+
+
+
+void fl_single_window_draw(SINGLEWINDOW n) {
+ static_cast<My_Single_Window*>(n)->Fl_Single_Window::draw();
+}
+
+int fl_single_window_handle(SINGLEWINDOW n, int e) {
+ return static_cast<My_Single_Window*>(n)->Fl_Single_Window::handle(e);
+}
+
+
diff --git a/body/c_fl_single_window.h b/body/c_fl_single_window.h
new file mode 100644
index 0000000..85e6e29
--- /dev/null
+++ b/body/c_fl_single_window.h
@@ -0,0 +1,33 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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, char* label);
+extern "C" void free_fl_single_window(SINGLEWINDOW w);
+
+
+extern "C" void fl_single_window_show(SINGLEWINDOW w);
+extern "C" void fl_single_window_show2(SINGLEWINDOW w, int c, void * v);
+extern "C" void fl_single_window_flush(SINGLEWINDOW w);
+
+
+extern "C" void fl_single_window_make_current(SINGLEWINDOW w);
+
+
+extern "C" void fl_single_window_draw(SINGLEWINDOW n);
+extern "C" int fl_single_window_handle(SINGLEWINDOW n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_slider.cpp b/body/c_fl_slider.cpp
new file mode 100644
index 0000000..449988c
--- /dev/null
+++ b/body/c_fl_slider.cpp
@@ -0,0 +1,128 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Slider.H>
+#include "c_fl_slider.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Slider : Fl_Slider {
+public:
+ // Really only needed for the (int,int,int,int) versions
+ using Fl_Slider::draw;
+ using Fl_Slider::handle;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Slider : public Fl_Slider {
+public:
+ using Fl_Slider::Fl_Slider;
+
+ friend void fl_slider_draw(SLIDER s);
+ friend int fl_slider_handle(SLIDER s, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Slider::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Slider::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Slider::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+SLIDER new_fl_slider(int x, int y, int w, int h, char* label) {
+ My_Slider *s = new My_Slider(x, y, w, h, label);
+ return s;
+}
+
+SLIDER new_fl_slider2(unsigned char k, int x, int y, int w, int h, char * label) {
+ My_Slider *s = new My_Slider(k, x, y, w, h, label);
+ return s;
+}
+
+void free_fl_slider(SLIDER s) {
+ delete static_cast<My_Slider*>(s);
+}
+
+
+
+
+void fl_slider_set_bounds(SLIDER s, double a, double b) {
+ static_cast<Fl_Slider*>(s)->bounds(a,b);
+}
+
+int fl_slider_get_slider(SLIDER s) {
+ return static_cast<Fl_Slider*>(s)->slider();
+}
+
+void fl_slider_set_slider(SLIDER s, int t) {
+ static_cast<Fl_Slider*>(s)->slider(static_cast<Fl_Boxtype>(t));
+}
+
+float fl_slider_get_slider_size(SLIDER s) {
+ return static_cast<Fl_Slider*>(s)->slider_size();
+}
+
+void fl_slider_set_slider_size(SLIDER s, double t) {
+ static_cast<Fl_Slider*>(s)->slider_size(t);
+}
+
+int fl_slider_scrollvalue(SLIDER s, int p, int z, int f, int t) {
+ return static_cast<Fl_Slider*>(s)->scrollvalue(p,z,f,t);
+}
+
+
+
+
+void fl_slider_draw(SLIDER s) {
+ static_cast<My_Slider*>(s)->Fl_Slider::draw();
+}
+
+void fl_slider_draw2(SLIDER s, int x, int y, int w, int h) {
+ void (Fl_Slider::*mydraw)(int,int,int,int) = &Friend_Slider::draw;
+ (static_cast<Fl_Slider*>(s)->*mydraw)(x, y, w, h);
+}
+
+int fl_slider_handle(SLIDER s, int e) {
+ return static_cast<My_Slider*>(s)->Fl_Slider::handle(e);
+}
+
+int fl_slider_handle2(SLIDER s, int e, int x, int y, int w, int h) {
+ int (Fl_Slider::*myhandle)(int,int,int,int,int) = &Friend_Slider::handle;
+ return (static_cast<Fl_Slider*>(s)->*myhandle)(e, x, y, w, h);
+}
+
+
diff --git a/body/c_fl_slider.h b/body/c_fl_slider.h
new file mode 100644
index 0000000..63c6ac3
--- /dev/null
+++ b/body/c_fl_slider.h
@@ -0,0 +1,35 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SLIDER_GUARD
+#define FL_SLIDER_GUARD
+
+
+typedef void* SLIDER;
+
+
+extern "C" SLIDER new_fl_slider(int x, int y, int w, int h, char* label);
+extern "C" SLIDER new_fl_slider2(unsigned char k, int x, int y, int w, int h, char * label);
+extern "C" void free_fl_slider(SLIDER s);
+
+
+extern "C" void fl_slider_set_bounds(SLIDER s, double a, double b);
+extern "C" int fl_slider_get_slider(SLIDER s);
+extern "C" void fl_slider_set_slider(SLIDER s, int t);
+extern "C" float fl_slider_get_slider_size(SLIDER s);
+extern "C" void fl_slider_set_slider_size(SLIDER s, double t);
+extern "C" int fl_slider_scrollvalue(SLIDER s, int p, int z, int f, int t);
+
+
+extern "C" void fl_slider_draw(SLIDER s);
+extern "C" void fl_slider_draw2(SLIDER s, int x, int y, int w, int h);
+extern "C" int fl_slider_handle(SLIDER s, int e);
+extern "C" int fl_slider_handle2(SLIDER s, int e, int x, int y, int w, int h);
+
+
+#endif
+
+
diff --git a/body/c_fl_spinner.cpp b/body/c_fl_spinner.cpp
new file mode 100644
index 0000000..67a5312
--- /dev/null
+++ b/body/c_fl_spinner.cpp
@@ -0,0 +1,175 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Spinner.H>
+#include "c_fl_spinner.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all hooks and friends
+
+class My_Spinner : public Fl_Spinner {
+public:
+ using Fl_Spinner::Fl_Spinner;
+
+ friend void fl_spinner_draw(SPINNER n);
+ friend int fl_spinner_handle(SPINNER n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Spinner::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Spinner::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+SPINNER new_fl_spinner(int x, int y, int w, int h, char* label) {
+ My_Spinner *n = new My_Spinner(x, y, w, h, label);
+ return n;
+}
+
+void free_fl_spinner(SPINNER n) {
+ delete static_cast<My_Spinner*>(n);
+}
+
+
+
+
+unsigned int fl_spinner_get_color(SPINNER n) {
+ return static_cast<Fl_Spinner*>(n)->color();
+}
+
+void fl_spinner_set_color(SPINNER n, unsigned int t) {
+ static_cast<Fl_Spinner*>(n)->color(t);
+}
+
+unsigned int fl_spinner_get_selection_color(SPINNER n) {
+ return static_cast<Fl_Spinner*>(n)->selection_color();
+}
+
+void fl_spinner_set_selection_color(SPINNER n, unsigned int t) {
+ static_cast<Fl_Spinner*>(n)->selection_color(t);
+}
+
+unsigned int fl_spinner_get_textcolor(SPINNER n) {
+ return static_cast<Fl_Spinner*>(n)->textcolor();
+}
+
+void fl_spinner_set_textcolor(SPINNER n, unsigned int t) {
+ static_cast<Fl_Spinner*>(n)->textcolor(t);
+}
+
+int fl_spinner_get_textfont(SPINNER n) {
+ return static_cast<Fl_Spinner*>(n)->textfont();
+}
+
+void fl_spinner_set_textfont(SPINNER n, int t) {
+ static_cast<Fl_Spinner*>(n)->textfont(t);
+}
+
+int fl_spinner_get_textsize(SPINNER n) {
+ return static_cast<Fl_Spinner*>(n)->textsize();
+}
+
+void fl_spinner_set_textsize(SPINNER n, int t) {
+ static_cast<Fl_Spinner*>(n)->textsize(t);
+}
+
+
+
+
+double fl_spinner_get_minimum(SPINNER n) {
+ return static_cast<Fl_Spinner*>(n)->minimum();
+}
+
+void fl_spinner_set_minimum(SPINNER n, double t) {
+ static_cast<Fl_Spinner*>(n)->minimum(t);
+}
+
+double fl_spinner_get_maximum(SPINNER n) {
+ return static_cast<Fl_Spinner*>(n)->maximum();
+}
+
+void fl_spinner_set_maximum(SPINNER n, double t) {
+ static_cast<Fl_Spinner*>(n)->maximum(t);
+}
+
+void fl_spinner_range(SPINNER n, double a, double b) {
+ static_cast<Fl_Spinner*>(n)->range(a,b);
+}
+
+double fl_spinner_get_step(SPINNER n) {
+ return static_cast<Fl_Spinner*>(n)->step();
+}
+
+void fl_spinner_set_step(SPINNER n, double t) {
+ static_cast<Fl_Spinner*>(n)->step(t);
+}
+
+double fl_spinner_get_value(SPINNER n) {
+ return static_cast<Fl_Spinner*>(n)->value();
+}
+
+void fl_spinner_set_value(SPINNER n, double t) {
+ static_cast<Fl_Spinner*>(n)->value(t);
+}
+
+
+
+
+const char * fl_spinner_get_format(SPINNER n) {
+ return static_cast<Fl_Spinner*>(n)->format();
+}
+
+void fl_spinner_set_format(SPINNER n, const char * f) {
+ static_cast<Fl_Spinner*>(n)->format(f);
+}
+
+unsigned char fl_spinner_get_type(SPINNER n) {
+ return static_cast<Fl_Spinner*>(n)->type();
+}
+
+void fl_spinner_set_type(SPINNER n, unsigned char t) {
+ static_cast<Fl_Spinner*>(n)->type(t);
+}
+
+
+
+
+void fl_spinner_resize(SPINNER n, int x, int y, int w, int h) {
+ static_cast<Fl_Spinner*>(n)->resize(x, y, w, h);
+}
+
+
+
+
+void fl_spinner_draw(SPINNER n) {
+ static_cast<My_Spinner*>(n)->Fl_Spinner::draw();
+}
+
+int fl_spinner_handle(SPINNER n, int e) {
+ return static_cast<My_Spinner*>(n)->Fl_Spinner::handle(e);
+}
+
+
diff --git a/body/c_fl_spinner.h b/body/c_fl_spinner.h
new file mode 100644
index 0000000..7447c33
--- /dev/null
+++ b/body/c_fl_spinner.h
@@ -0,0 +1,56 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SPINNER_GUARD
+#define FL_SPINNER_GUARD
+
+
+typedef void* SPINNER;
+
+
+extern "C" SPINNER new_fl_spinner(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_spinner(SPINNER n);
+
+
+extern "C" unsigned int fl_spinner_get_color(SPINNER n);
+extern "C" void fl_spinner_set_color(SPINNER n, unsigned int t);
+extern "C" unsigned int fl_spinner_get_selection_color(SPINNER n);
+extern "C" void fl_spinner_set_selection_color(SPINNER n, unsigned int t);
+extern "C" unsigned int fl_spinner_get_textcolor(SPINNER n);
+extern "C" void fl_spinner_set_textcolor(SPINNER n, unsigned int t);
+extern "C" int fl_spinner_get_textfont(SPINNER n);
+extern "C" void fl_spinner_set_textfont(SPINNER n, int t);
+extern "C" int fl_spinner_get_textsize(SPINNER n);
+extern "C" void fl_spinner_set_textsize(SPINNER n, int t);
+
+
+extern "C" double fl_spinner_get_minimum(SPINNER n);
+extern "C" void fl_spinner_set_minimum(SPINNER n, double t);
+extern "C" double fl_spinner_get_maximum(SPINNER n);
+extern "C" void fl_spinner_set_maximum(SPINNER n, double t);
+extern "C" void fl_spinner_range(SPINNER n, double a, double b);
+extern "C" double fl_spinner_get_step(SPINNER n);
+extern "C" void fl_spinner_set_step(SPINNER n, double t);
+extern "C" double fl_spinner_get_value(SPINNER n);
+extern "C" void fl_spinner_set_value(SPINNER n, double t);
+
+
+extern "C" const char * fl_spinner_get_format(SPINNER n);
+extern "C" void fl_spinner_set_format(SPINNER n, const char * f);
+extern "C" unsigned char fl_spinner_get_type(SPINNER n);
+extern "C" void fl_spinner_set_type(SPINNER n, unsigned char t);
+
+
+extern "C" void fl_spinner_resize(SPINNER n, int x, int y, int w, int h);
+
+
+extern "C" void fl_spinner_draw(SPINNER n);
+extern "C" int fl_spinner_handle(SPINNER n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_static.cpp b/body/c_fl_static.cpp
new file mode 100644
index 0000000..ad4cfe9
--- /dev/null
+++ b/body/c_fl_static.cpp
@@ -0,0 +1,305 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl.H>
+#include <FL/Fl_Widget.H>
+#include <FL/Fl_Window.H>
+#include "c_fl_static.h"
+
+
+
+
+void fl_static_add_awake_handler(void * h, void * f) {
+ Fl::add_awake_handler_(reinterpret_cast<Fl_Awake_Handler>(h),f);
+}
+
+void fl_static_get_awake_handler(void * &h, void * &f) {
+ Fl::get_awake_handler_(reinterpret_cast<Fl_Awake_Handler&>(h),f);
+}
+
+
+
+
+void fl_static_add_check(void * h, void * f) {
+ Fl::add_check(reinterpret_cast<Fl_Timeout_Handler>(h),f);
+}
+
+int fl_static_has_check(void * h, void * f) {
+ return Fl::has_check(reinterpret_cast<Fl_Timeout_Handler>(h),f);
+}
+
+void fl_static_remove_check(void * h, void * f) {
+ Fl::remove_check(reinterpret_cast<Fl_Timeout_Handler>(h),f);
+}
+
+
+
+
+void fl_static_add_timeout(double s, void * h, void * f) {
+ Fl::add_timeout(s,reinterpret_cast<Fl_Timeout_Handler>(h),f);
+}
+
+int fl_static_has_timeout(void * h, void * f) {
+ return Fl::has_timeout(reinterpret_cast<Fl_Timeout_Handler>(h),f);
+}
+
+void fl_static_remove_timeout(void * h, void * f) {
+ Fl::remove_timeout(reinterpret_cast<Fl_Timeout_Handler>(h),f);
+}
+
+void fl_static_repeat_timeout(double s, void * h, void * f) {
+ Fl::repeat_timeout(s,reinterpret_cast<Fl_Timeout_Handler>(h),f);
+}
+
+
+
+
+void fl_static_add_clipboard_notify(void * h, void * f) {
+ Fl::add_clipboard_notify(reinterpret_cast<Fl_Clipboard_Notify_Handler>(h),f);
+}
+
+
+
+
+void fl_static_add_fd(int d, void * h, void * f) {
+ Fl::add_fd(d,reinterpret_cast<Fl_FD_Handler>(h),f);
+}
+
+void fl_static_add_fd2(int d, int m, void * h, void * f) {
+ Fl::add_fd(d,m,reinterpret_cast<Fl_FD_Handler>(h),f);
+}
+
+void fl_static_remove_fd(int d) {
+ Fl::remove_fd(d);
+}
+
+void fl_static_remove_fd2(int d, int m) {
+ Fl::remove_fd(d,m);
+}
+
+
+
+
+void fl_static_add_idle(void * h, void * f) {
+ Fl::add_idle(reinterpret_cast<Fl_Idle_Handler>(h),f);
+}
+
+int fl_static_has_idle(void * h, void * f) {
+ return Fl::has_idle(reinterpret_cast<Fl_Idle_Handler>(h),f);
+}
+
+void fl_static_remove_idle(void * h, void * f) {
+ Fl::remove_idle(reinterpret_cast<Fl_Idle_Handler>(h),f);
+}
+
+
+
+
+void fl_static_get_color(unsigned int c, unsigned char &r, unsigned char &g, unsigned char &b) {
+ Fl::get_color(c,r,g,b);
+}
+
+void fl_static_set_color(unsigned int c, unsigned char r, unsigned char g, unsigned char b) {
+ Fl::set_color(c,r,g,b);
+}
+
+void fl_static_free_color(unsigned int c, int b) {
+ Fl::free_color(c,b);
+}
+
+void fl_static_foreground(unsigned int r, unsigned int g, unsigned int b) {
+ Fl::foreground(r,g,b);
+}
+
+void fl_static_background(unsigned int r, unsigned int g, unsigned int b) {
+ Fl::background(r,g,b);
+}
+
+void fl_static_background2(unsigned int r, unsigned int g, unsigned int b) {
+ Fl::background2(r,g,b);
+}
+
+
+
+
+const char * fl_static_get_font(int f) {
+ return Fl::get_font(f);
+}
+
+const char * fl_static_get_font_name(int f) {
+ return Fl::get_font_name(f);
+}
+
+void fl_static_set_font(int t, int f) {
+ Fl::set_font(t,f);
+}
+
+int fl_static_get_font_sizes(int f, int * &a) {
+ return Fl::get_font_sizes(static_cast<Fl_Font>(f),a);
+}
+
+int fl_static_font_size_array_get(int * a, int i) {
+ return *(a+((i-1)*sizeof(int)));
+}
+
+int fl_static_set_fonts() {
+ return Fl::set_fonts();
+}
+
+
+
+
+int fl_static_box_dh(int b) {
+ return Fl::box_dh(static_cast<Fl_Boxtype>(b));
+}
+
+int fl_static_box_dw(int b) {
+ return Fl::box_dw(static_cast<Fl_Boxtype>(b));
+}
+
+int fl_static_box_dx(int b) {
+ return Fl::box_dx(static_cast<Fl_Boxtype>(b));
+}
+
+int fl_static_box_dy(int b) {
+ return Fl::box_dy(static_cast<Fl_Boxtype>(b));
+}
+
+void fl_static_set_boxtype(int t, int f) {
+ Fl::set_boxtype(static_cast<Fl_Boxtype>(t),static_cast<Fl_Boxtype>(f));
+}
+
+int fl_static_draw_box_active() {
+ return Fl::draw_box_active();
+}
+
+
+
+
+void fl_static_copy(const char * t, int l, int k) {
+ Fl::copy(t,l,k);
+}
+
+void fl_static_paste(void * r, int s) {
+ Fl_Widget &ref = *static_cast<Fl_Widget*>(r);
+ Fl::paste(ref, s);
+}
+
+void fl_static_selection(void * o, char * t, int l) {
+ Fl_Widget &ref = *static_cast<Fl_Widget*>(o);
+ Fl::selection(ref, t, l);
+}
+
+
+
+
+void fl_static_dnd() {
+ Fl::dnd();
+}
+
+int fl_static_get_dnd_text_ops() {
+ return Fl::dnd_text_ops();
+}
+
+void fl_static_set_dnd_text_ops(int t) {
+ Fl::dnd_text_ops(t);
+}
+
+
+
+
+void fl_static_enable_im() {
+ Fl::enable_im();
+}
+
+void fl_static_disable_im() {
+ Fl::disable_im();
+}
+
+int fl_static_get_visible_focus() {
+ return Fl::visible_focus();
+}
+
+void fl_static_set_visible_focus(int f) {
+ Fl::visible_focus(f);
+}
+
+
+
+
+void fl_static_default_atclose(void * w) {
+ Fl::default_atclose(static_cast<Fl_Window*>(w), 0);
+}
+
+void * fl_static_get_first_window() {
+ return Fl::first_window();
+}
+
+void fl_static_set_first_window(void * w) {
+ Fl::first_window(static_cast<Fl_Window*>(w));
+}
+
+void * fl_static_next_window(void * w) {
+ return Fl::next_window(static_cast<Fl_Window*>(w));
+}
+
+void * fl_static_modal() {
+ return Fl::modal();
+}
+
+
+
+
+void * fl_static_readqueue() {
+ return Fl::readqueue();
+}
+
+void fl_static_do_widget_deletion() {
+ Fl::do_widget_deletion();
+}
+
+
+
+
+const char * fl_static_get_scheme() {
+ return Fl::scheme();
+}
+
+void fl_static_set_scheme(const char *n) {
+ Fl::scheme(n);
+}
+
+int fl_static_is_scheme(const char *n) {
+ return Fl::is_scheme(n);
+}
+
+void fl_static_reload_scheme() {
+ Fl::reload_scheme();
+}
+
+
+
+
+int fl_static_get_option(int o) {
+ return Fl::option(static_cast<Fl::Fl_Option>(o));
+}
+
+void fl_static_set_option(int o, int t) {
+ Fl::option(static_cast<Fl::Fl_Option>(o),t);
+}
+
+
+
+
+int fl_static_get_scrollbar_size() {
+ return Fl::scrollbar_size();
+}
+
+void fl_static_set_scrollbar_size(int s) {
+ Fl::scrollbar_size(s);
+}
+
+
diff --git a/body/c_fl_static.h b/body/c_fl_static.h
new file mode 100644
index 0000000..692750b
--- /dev/null
+++ b/body/c_fl_static.h
@@ -0,0 +1,109 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_STATIC_GUARD
+#define FL_STATIC_GUARD
+
+
+extern "C" void fl_static_add_awake_handler(void * h, void * f);
+extern "C" void fl_static_get_awake_handler(void * &h, void * &f);
+
+
+extern "C" void fl_static_add_check(void * h, void * f);
+extern "C" int fl_static_has_check(void * h, void * f);
+extern "C" void fl_static_remove_check(void * h, void * f);
+
+
+extern "C" void fl_static_add_timeout(double s, void * h, void * f);
+extern "C" int fl_static_has_timeout(void * h, void * f);
+extern "C" void fl_static_remove_timeout(void * h, void * f);
+extern "C" void fl_static_repeat_timeout(double s, void * h, void * f);
+
+
+extern "C" void fl_static_add_clipboard_notify(void * h, void * f);
+
+
+extern "C" void fl_static_add_fd(int d, void * h, void * f);
+extern "C" void fl_static_add_fd2(int d, int m, void * h, void * f);
+extern "C" void fl_static_remove_fd(int d);
+extern "C" void fl_static_remove_fd2(int d, int m);
+
+
+extern "C" void fl_static_add_idle(void * h, void * f);
+extern "C" int fl_static_has_idle(void * h, void * f);
+extern "C" void fl_static_remove_idle(void * h, void * f);
+
+
+extern "C" void fl_static_get_color(unsigned int c,
+ unsigned char &r, unsigned char &g, unsigned char &b);
+extern "C" void fl_static_set_color(unsigned int c,
+ unsigned char r, unsigned char g, unsigned char b);
+extern "C" void fl_static_free_color(unsigned int c, int b);
+extern "C" void fl_static_foreground(unsigned int r, unsigned int g, unsigned int b);
+extern "C" void fl_static_background(unsigned int r, unsigned int g, unsigned int b);
+extern "C" void fl_static_background2(unsigned int r, unsigned int g, unsigned int b);
+
+
+extern "C" const char * fl_static_get_font(int f);
+extern "C" const char * fl_static_get_font_name(int f);
+extern "C" void fl_static_set_font(int t, int f);
+extern "C" int fl_static_get_font_sizes(int f, int * &a);
+extern "C" int fl_static_font_size_array_get(int * a, int i);
+extern "C" int fl_static_set_fonts();
+
+
+extern "C" int fl_static_box_dh(int b);
+extern "C" int fl_static_box_dw(int b);
+extern "C" int fl_static_box_dx(int b);
+extern "C" int fl_static_box_dy(int b);
+extern "C" void fl_static_set_boxtype(int t, int f);
+extern "C" int fl_static_draw_box_active();
+
+
+extern "C" void fl_static_copy(const char * t, int l, int k);
+extern "C" void fl_static_paste(void * r, int s);
+extern "C" void fl_static_selection(void * o, char * t, int l);
+
+
+extern "C" void fl_static_dnd();
+extern "C" int fl_static_get_dnd_text_ops();
+extern "C" void fl_static_set_dnd_text_ops(int t);
+
+
+extern "C" void fl_static_enable_im();
+extern "C" void fl_static_disable_im();
+extern "C" int fl_static_get_visible_focus();
+extern "C" void fl_static_set_visible_focus(int f);
+
+
+extern "C" void fl_static_default_atclose(void * w);
+extern "C" void * fl_static_get_first_window();
+extern "C" void fl_static_set_first_window(void * w);
+extern "C" void * fl_static_next_window(void * w);
+extern "C" void * fl_static_modal();
+
+
+extern "C" void * fl_static_readqueue();
+extern "C" void fl_static_do_widget_deletion();
+
+
+extern "C" const char * fl_static_get_scheme();
+extern "C" void fl_static_set_scheme(const char *n);
+extern "C" int fl_static_is_scheme(const char *n);
+extern "C" void fl_static_reload_scheme();
+
+
+extern "C" int fl_static_get_option(int o);
+extern "C" void fl_static_set_option(int o, int t);
+
+
+extern "C" int fl_static_get_scrollbar_size();
+extern "C" void fl_static_set_scrollbar_size(int s);
+
+
+#endif
+
+
diff --git a/body/c_fl_surface_device.cpp b/body/c_fl_surface_device.cpp
new file mode 100644
index 0000000..9836a04
--- /dev/null
+++ b/body/c_fl_surface_device.cpp
@@ -0,0 +1,58 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Device.H>
+#include "c_fl_surface_device.h"
+
+
+
+
+// Adding relevant friends
+
+class My_Surface_Device : public Fl_Surface_Device {
+public:
+ using Fl_Surface_Device::Fl_Surface_Device;
+ friend SURFACEDEVICE new_fl_surface_device(void * g);
+};
+
+
+
+
+// Flattened C API
+
+SURFACEDEVICE new_fl_surface_device(void * g) {
+ My_Surface_Device *s = new My_Surface_Device(static_cast<Fl_Graphics_Driver*>(g));
+ return s;
+}
+
+void free_fl_surface_device(SURFACEDEVICE s) {
+ delete static_cast<My_Surface_Device*>(s);
+}
+
+
+
+
+void fl_surface_device_set_current(SURFACEDEVICE s) {
+ // virtual so disable dispatch
+ static_cast<Fl_Surface_Device*>(s)->Fl_Surface_Device::set_current();
+}
+
+SURFACEDEVICE fl_surface_device_get_surface(void) {
+ return Fl_Surface_Device::surface();
+}
+
+
+
+
+void * fl_surface_device_get_driver(SURFACEDEVICE s) {
+ return static_cast<Fl_Surface_Device*>(s)->driver();
+}
+
+void fl_surface_device_set_driver(SURFACEDEVICE s, void * g) {
+ static_cast<Fl_Surface_Device*>(s)->driver(static_cast<Fl_Graphics_Driver*>(g));
+}
+
+
diff --git a/body/c_fl_surface_device.h b/body/c_fl_surface_device.h
new file mode 100644
index 0000000..97096c6
--- /dev/null
+++ b/body/c_fl_surface_device.h
@@ -0,0 +1,28 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SURFACE_DEVICE_GUARD
+#define FL_SURFACE_DEVICE_GUARD
+
+
+typedef void* SURFACEDEVICE;
+
+
+extern "C" SURFACEDEVICE new_fl_surface_device(void * g);
+extern "C" void free_fl_surface_device(SURFACEDEVICE s);
+
+
+extern "C" void fl_surface_device_set_current(SURFACEDEVICE s);
+extern "C" SURFACEDEVICE fl_surface_device_get_surface(void);
+
+
+extern "C" void * fl_surface_device_get_driver(SURFACEDEVICE s);
+extern "C" void fl_surface_device_set_driver(SURFACEDEVICE s, void * g);
+
+
+#endif
+
+
diff --git a/body/c_fl_sys_menu_bar.cpp b/body/c_fl_sys_menu_bar.cpp
new file mode 100644
index 0000000..fbd6e34
--- /dev/null
+++ b/body/c_fl_sys_menu_bar.cpp
@@ -0,0 +1,158 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Sys_Menu_Bar.H>
+#include <FL/Fl_Menu_Item.H>
+#include "c_fl_sys_menu_bar.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" void menu_item_callback_hook(void * cobj, void * ud);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Sys_Menu_Bar : public Fl_Sys_Menu_Bar {
+public:
+ using Fl_Sys_Menu_Bar::Fl_Sys_Menu_Bar;
+
+ friend void fl_sys_menu_bar_draw(SYSMENUBAR m);
+ friend int fl_sys_menu_bar_handle(SYSMENUBAR m, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Sys_Menu_Bar::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Sys_Menu_Bar::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+SYSMENUBAR new_fl_sys_menu_bar(int x, int y, int w, int h, char* label) {
+ My_Sys_Menu_Bar *m = new My_Sys_Menu_Bar(x, y, w, h, label);
+ return m;
+}
+
+void free_fl_sys_menu_bar(SYSMENUBAR m) {
+ delete static_cast<My_Sys_Menu_Bar*>(m);
+}
+
+
+
+
+int fl_sys_menu_bar_add(SYSMENUBAR m, const char * t) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->add(t);
+}
+
+int fl_sys_menu_bar_add2(SYSMENUBAR m, const char * t, int s, void * u, int f) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->add(t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+int fl_sys_menu_bar_add3(SYSMENUBAR m, const char * t, const char * s, void * u, int f) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->add(t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+int fl_sys_menu_bar_insert(SYSMENUBAR m, int p, const char * t, int s, void * u, int f) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->insert(p, t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+int fl_sys_menu_bar_insert2(SYSMENUBAR m, int p, const char * t, const char * s, void * u, int f) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->insert(p, t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+void fl_sys_menu_bar_set_menu(SYSMENUBAR m, void * d) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->menu(static_cast<Fl_Menu_*>(d)->menu());
+}
+
+void fl_sys_menu_bar_remove(SYSMENUBAR m, int p) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->remove(p);
+}
+
+void fl_sys_menu_bar_clear(SYSMENUBAR m) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->clear();
+}
+
+int fl_sys_menu_bar_clear_submenu(SYSMENUBAR m, int i) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->clear_submenu(i);
+}
+
+
+
+
+const void * fl_sys_menu_bar_get_item(SYSMENUBAR m, int i) {
+ return &(static_cast<Fl_Sys_Menu_Bar*>(m)->menu()[i]);
+}
+
+
+
+
+void fl_sys_menu_bar_setonly(SYSMENUBAR m, void * mi) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->setonly(static_cast<Fl_Menu_Item*>(mi));
+}
+
+void fl_sys_menu_bar_replace(SYSMENUBAR m, int i, const char * t) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->replace(i, t);
+}
+
+void fl_sys_menu_bar_shortcut(SYSMENUBAR m, int i, int s) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->shortcut(i, s);
+}
+
+int fl_sys_menu_bar_get_mode(SYSMENUBAR m, int i) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->mode(i);
+}
+
+void fl_sys_menu_bar_set_mode(SYSMENUBAR m, int i, int f) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->mode(i, f);
+}
+
+
+
+
+void fl_sys_menu_bar_global(SYSMENUBAR m) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->global();
+}
+
+void fl_sys_menu_bar_update(SYSMENUBAR m) {
+#if FLTK_ABI_VERSION >= 10304
+ static_cast<Fl_Sys_Menu_Bar*>(m)->update();
+#else
+ (void)(m);
+#endif
+}
+
+
+
+
+void fl_sys_menu_bar_draw(SYSMENUBAR m) {
+ static_cast<My_Sys_Menu_Bar*>(m)->Fl_Sys_Menu_Bar::draw();
+}
+
+int fl_sys_menu_bar_handle(SYSMENUBAR m, int e) {
+ return static_cast<My_Sys_Menu_Bar*>(m)->Fl_Sys_Menu_Bar::handle(e);
+}
+
+
diff --git a/body/c_fl_sys_menu_bar.h b/body/c_fl_sys_menu_bar.h
new file mode 100644
index 0000000..1bde8f2
--- /dev/null
+++ b/body/c_fl_sys_menu_bar.h
@@ -0,0 +1,50 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SYS_MENU_BAR_GUARD
+#define FL_SYS_MENU_BAR_GUARD
+
+
+typedef void* SYSMENUBAR;
+
+
+extern "C" SYSMENUBAR new_fl_sys_menu_bar(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_sys_menu_bar(SYSMENUBAR m);
+
+
+extern "C" int fl_sys_menu_bar_add(SYSMENUBAR m, const char * t);
+extern "C" int fl_sys_menu_bar_add2(SYSMENUBAR m, const char * t, int s, void * u, int f);
+extern "C" int fl_sys_menu_bar_add3(SYSMENUBAR m, const char * t, const char * s, void * u, int f);
+extern "C" int fl_sys_menu_bar_insert(SYSMENUBAR m, int p, const char * t, int s, void * u, int f);
+extern "C" int fl_sys_menu_bar_insert2(SYSMENUBAR m, int p, const char * t,
+ const char * s, void * u, int f);
+extern "C" void fl_sys_menu_bar_set_menu(SYSMENUBAR m, void * d);
+extern "C" void fl_sys_menu_bar_remove(SYSMENUBAR m, int p);
+extern "C" void fl_sys_menu_bar_clear(SYSMENUBAR m);
+extern "C" int fl_sys_menu_bar_clear_submenu(SYSMENUBAR m, int p);
+
+
+extern "C" const void * fl_sys_menu_bar_get_item(SYSMENUBAR m, int i);
+
+
+extern "C" void fl_sys_menu_bar_setonly(SYSMENUBAR m, void * mi);
+extern "C" void fl_sys_menu_bar_replace(SYSMENUBAR m, int i, const char * t);
+extern "C" void fl_sys_menu_bar_shortcut(SYSMENUBAR m, int p, int s);
+extern "C" int fl_sys_menu_bar_get_mode(SYSMENUBAR m, int p);
+extern "C" void fl_sys_menu_bar_set_mode(SYSMENUBAR m, int p, int f);
+
+
+extern "C" void fl_sys_menu_bar_global(SYSMENUBAR m);
+extern "C" void fl_sys_menu_bar_update(SYSMENUBAR m);
+
+
+extern "C" void fl_sys_menu_bar_draw(SYSMENUBAR m);
+extern "C" int fl_sys_menu_bar_handle(SYSMENUBAR m, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_tabs.cpp b/body/c_fl_tabs.cpp
new file mode 100644
index 0000000..df7327f
--- /dev/null
+++ b/body/c_fl_tabs.cpp
@@ -0,0 +1,111 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Tabs.H>
+#include "c_fl_tabs.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Tabs : Fl_Tabs {
+public:
+ using Fl_Tabs::redraw_tabs;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Tabs : public Fl_Tabs {
+public:
+ using Fl_Tabs::Fl_Tabs;
+
+ friend void fl_tabs_draw(TABS t);
+ friend int fl_tabs_handle(TABS t, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Tabs::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Tabs::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+TABS new_fl_tabs(int x, int y, int w, int h, char* label) {
+ My_Tabs *t = new My_Tabs(x, y, w, h, label);
+ return t;
+}
+
+void free_fl_tabs(TABS t) {
+ delete static_cast<My_Tabs*>(t);
+}
+
+
+
+
+void fl_tabs_client_area(TABS t, int * x, int * y, int * w, int * h, int i) {
+ static_cast<Fl_Tabs*>(t)->client_area(*x,*y,*w,*h,i);
+}
+
+
+
+
+void * fl_tabs_get_push(TABS t) {
+ return static_cast<Fl_Tabs*>(t)->push();
+}
+
+void fl_tabs_set_push(TABS t, void * w) {
+ static_cast<Fl_Tabs*>(t)->push(static_cast<Fl_Widget*>(w));
+}
+
+void * fl_tabs_get_value(TABS t) {
+ return static_cast<Fl_Tabs*>(t)->value();
+}
+
+void fl_tabs_set_value(TABS t, void * w) {
+ static_cast<Fl_Tabs*>(t)->value(static_cast<Fl_Widget*>(w));
+}
+
+void * fl_tabs_which(TABS t, int x, int y) {
+ return static_cast<Fl_Tabs*>(t)->which(x,y);
+}
+
+
+
+
+void fl_tabs_draw(TABS t) {
+ static_cast<My_Tabs*>(t)->Fl_Tabs::draw();
+}
+
+void fl_tabs_redraw_tabs(TABS t) {
+ (static_cast<Fl_Tabs*>(t)->*(&Friend_Tabs::redraw_tabs))();
+}
+
+int fl_tabs_handle(TABS t, int e) {
+ return static_cast<My_Tabs*>(t)->Fl_Tabs::handle(e);
+}
+
+
diff --git a/body/c_fl_tabs.h b/body/c_fl_tabs.h
new file mode 100644
index 0000000..3226b2d
--- /dev/null
+++ b/body/c_fl_tabs.h
@@ -0,0 +1,35 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_TABS_GUARD
+#define FL_TABS_GUARD
+
+
+typedef void* TABS;
+
+
+extern "C" TABS new_fl_tabs(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_tabs(TABS t);
+
+
+extern "C" void fl_tabs_client_area(TABS t, int * x, int * y, int * w, int * h, int i);
+
+
+extern "C" void * fl_tabs_get_push(TABS t);
+extern "C" void fl_tabs_set_push(TABS t, void * w);
+extern "C" void * fl_tabs_get_value(TABS t);
+extern "C" void fl_tabs_set_value(TABS t, void * w);
+extern "C" void * fl_tabs_which(TABS t, int x, int y);
+
+
+extern "C" void fl_tabs_draw(TABS t);
+extern "C" void fl_tabs_redraw_tabs(TABS t);
+extern "C" int fl_tabs_handle(TABS t, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_text_buffer.cpp b/body/c_fl_text_buffer.cpp
new file mode 100644
index 0000000..2322984
--- /dev/null
+++ b/body/c_fl_text_buffer.cpp
@@ -0,0 +1,296 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Text_Buffer.H>
+#include "c_fl_text_buffer.h"
+
+
+
+
+class My_Text_Buffer : public Fl_Text_Buffer {
+public:
+ using Fl_Text_Buffer::Fl_Text_Buffer;
+ int reference_count = 0;
+};
+
+
+
+
+TEXTBUFFER new_fl_text_buffer(int rs, int pgs) {
+ My_Text_Buffer *tb = new My_Text_Buffer(rs, pgs);
+ return tb;
+}
+
+void upref_fl_text_buffer(TEXTBUFFER tb) {
+ static_cast<My_Text_Buffer*>(tb)->reference_count += 1;
+}
+
+void free_fl_text_buffer(TEXTBUFFER tb) {
+ if (static_cast<My_Text_Buffer*>(tb)->reference_count <= 0) {
+ delete static_cast<My_Text_Buffer*>(tb);
+ } else {
+ static_cast<My_Text_Buffer*>(tb)->reference_count -= 1;
+ }
+}
+
+
+
+
+void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud) {
+ static_cast<Fl_Text_Buffer*>(tb)->add_modify_callback
+ (reinterpret_cast<Fl_Text_Modify_Cb>(cb), ud);
+}
+
+void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud) {
+ static_cast<Fl_Text_Buffer*>(tb)->add_predelete_callback
+ (reinterpret_cast<Fl_Text_Predelete_Cb>(cb), ud);
+}
+
+void fl_text_buffer_call_modify_callbacks(TEXTBUFFER tb) {
+ static_cast<Fl_Text_Buffer*>(tb)->call_modify_callbacks();
+}
+
+void fl_text_buffer_call_predelete_callbacks(TEXTBUFFER tb) {
+ static_cast<Fl_Text_Buffer*>(tb)->call_predelete_callbacks();
+}
+
+
+
+
+int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n, int b) {
+ return static_cast<Fl_Text_Buffer*>(tb)->loadfile(n,b);
+}
+
+int fl_text_buffer_appendfile(TEXTBUFFER tb, char * n, int b) {
+ return static_cast<Fl_Text_Buffer*>(tb)->appendfile(n,b);
+}
+
+int fl_text_buffer_insertfile(TEXTBUFFER tb, char * n, int p, int b) {
+ return static_cast<Fl_Text_Buffer*>(tb)->insertfile(n,p,b);
+}
+
+int fl_text_buffer_outputfile(TEXTBUFFER tb, char * n, int f, int t, int b) {
+ return static_cast<Fl_Text_Buffer*>(tb)->outputfile(n,f,t,b);
+}
+
+int fl_text_buffer_savefile(TEXTBUFFER tb, char * n, int b) {
+ return static_cast<Fl_Text_Buffer*>(tb)->savefile(n,b);
+}
+
+
+
+
+void fl_text_buffer_insert(TEXTBUFFER tb, int p, const char * item) {
+ static_cast<Fl_Text_Buffer*>(tb)->insert(p, item);
+}
+
+void fl_text_buffer_append(TEXTBUFFER tb, const char * item) {
+ static_cast<Fl_Text_Buffer*>(tb)->append(item);
+}
+
+void fl_text_buffer_replace(TEXTBUFFER tb, int s, int f, const char * text) {
+ static_cast<Fl_Text_Buffer*>(tb)->replace(s, f, text);
+}
+
+void fl_text_buffer_remove(TEXTBUFFER tb, int s, int f) {
+ static_cast<Fl_Text_Buffer*>(tb)->remove(s, f);
+}
+
+char * fl_text_buffer_get_text(TEXTBUFFER tb) {
+ return static_cast<Fl_Text_Buffer*>(tb)->text();
+}
+
+void fl_text_buffer_set_text(TEXTBUFFER tb, char * t) {
+ static_cast<Fl_Text_Buffer*>(tb)->text(t);
+}
+
+char fl_text_buffer_byte_at(TEXTBUFFER tb, int p) {
+ return static_cast<Fl_Text_Buffer*>(tb)->byte_at(p);
+}
+
+unsigned int fl_text_buffer_char_at(TEXTBUFFER tb, int p) {
+ return static_cast<Fl_Text_Buffer*>(tb)->char_at(p);
+}
+
+char * fl_text_buffer_text_range(TEXTBUFFER tb, int s, int f) {
+ return static_cast<Fl_Text_Buffer*>(tb)->text_range(s, f);
+}
+
+int fl_text_buffer_next_char(TEXTBUFFER tb, int p) {
+ return static_cast<Fl_Text_Buffer*>(tb)->next_char(p);
+}
+
+int fl_text_buffer_prev_char(TEXTBUFFER tb, int p) {
+ return static_cast<Fl_Text_Buffer*>(tb)->prev_char(p);
+}
+
+
+
+
+int fl_text_buffer_count_displayed_characters(TEXTBUFFER tb, int s, int f) {
+ return static_cast<Fl_Text_Buffer*>(tb)->count_displayed_characters(s,f);
+}
+
+int fl_text_buffer_count_lines(TEXTBUFFER tb, int s, int f) {
+ return static_cast<Fl_Text_Buffer*>(tb)->count_lines(s,f);
+}
+
+int fl_text_buffer_length(TEXTBUFFER tb) {
+ return static_cast<Fl_Text_Buffer*>(tb)->length();
+}
+
+int fl_text_buffer_get_tab_distance(TEXTBUFFER tb) {
+ return static_cast<Fl_Text_Buffer*>(tb)->tab_distance();
+}
+
+void fl_text_buffer_set_tab_distance(TEXTBUFFER tb, int t) {
+ static_cast<Fl_Text_Buffer*>(tb)->tab_distance(t);
+}
+
+
+
+
+int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e) {
+ return static_cast<Fl_Text_Buffer*>(tb)->selection_position(s, e);
+}
+
+int fl_text_buffer_secondary_selection_position(TEXTBUFFER tb, int * s, int * e) {
+ return static_cast<Fl_Text_Buffer*>(tb)->secondary_selection_position(s,e);
+}
+
+void fl_text_buffer_select(TEXTBUFFER tb, int s, int e) {
+ static_cast<Fl_Text_Buffer*>(tb)->select(s, e);
+}
+
+void fl_text_buffer_secondary_select(TEXTBUFFER tb, int s, int e) {
+ static_cast<Fl_Text_Buffer*>(tb)->secondary_select(s,e);
+}
+
+int fl_text_buffer_selected(TEXTBUFFER tb) {
+ return static_cast<Fl_Text_Buffer*>(tb)->selected();
+}
+
+int fl_text_buffer_secondary_selected(TEXTBUFFER tb) {
+ return static_cast<Fl_Text_Buffer*>(tb)->secondary_selected();
+}
+
+char * fl_text_buffer_selection_text(TEXTBUFFER tb) {
+ return static_cast<Fl_Text_Buffer*>(tb)->selection_text();
+}
+
+char * fl_text_buffer_secondary_selection_text(TEXTBUFFER tb) {
+ return static_cast<Fl_Text_Buffer*>(tb)->secondary_selection_text();
+}
+
+void fl_text_buffer_replace_selection(TEXTBUFFER tb, char * t) {
+ static_cast<Fl_Text_Buffer*>(tb)->replace_selection(t);
+}
+
+void fl_text_buffer_replace_secondary_selection(TEXTBUFFER tb, char * t) {
+ static_cast<Fl_Text_Buffer*>(tb)->replace_secondary_selection(t);
+}
+
+void fl_text_buffer_remove_selection(TEXTBUFFER tb) {
+ static_cast<Fl_Text_Buffer*>(tb)->remove_selection();
+}
+
+void fl_text_buffer_remove_secondary_selection(TEXTBUFFER tb) {
+ static_cast<Fl_Text_Buffer*>(tb)->remove_secondary_selection();
+}
+
+void fl_text_buffer_unselect(TEXTBUFFER tb) {
+ static_cast<Fl_Text_Buffer*>(tb)->unselect();
+}
+
+void fl_text_buffer_secondary_unselect(TEXTBUFFER tb) {
+ static_cast<Fl_Text_Buffer*>(tb)->secondary_unselect();
+}
+
+
+
+
+void fl_text_buffer_highlight(TEXTBUFFER tb, int f, int t) {
+ static_cast<Fl_Text_Buffer*>(tb)->highlight(f,t);
+}
+
+char * fl_text_buffer_highlight_text(TEXTBUFFER tb) {
+ return static_cast<Fl_Text_Buffer*>(tb)->highlight_text();
+}
+
+void fl_text_buffer_unhighlight(TEXTBUFFER tb) {
+ static_cast<Fl_Text_Buffer*>(tb)->unhighlight();
+}
+
+
+
+
+int fl_text_buffer_findchar_forward(TEXTBUFFER tb, int start, unsigned int item, int * found) {
+ return static_cast<Fl_Text_Buffer*>(tb)->findchar_forward(start, item, found);
+}
+
+int fl_text_buffer_findchar_backward(TEXTBUFFER tb, int start, unsigned int item, int * found) {
+ return static_cast<Fl_Text_Buffer*>(tb)->findchar_backward(start, item, found);
+}
+
+int fl_text_buffer_search_forward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase) {
+ return static_cast<Fl_Text_Buffer*>(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 static_cast<Fl_Text_Buffer*>(tb)->search_backward(start, item, found, mcase);
+}
+
+
+
+
+int fl_text_buffer_word_start(TEXTBUFFER tb, int p) {
+ return static_cast<Fl_Text_Buffer*>(tb)->word_start(p);
+}
+
+int fl_text_buffer_word_end(TEXTBUFFER tb, int p) {
+ return static_cast<Fl_Text_Buffer*>(tb)->word_end(p);
+}
+
+int fl_text_buffer_line_start(TEXTBUFFER tb, int p) {
+ return static_cast<Fl_Text_Buffer*>(tb)->line_start(p);
+}
+
+int fl_text_buffer_line_end(TEXTBUFFER tb, int p) {
+ return static_cast<Fl_Text_Buffer*>(tb)->line_end(p);
+}
+
+char * fl_text_buffer_line_text(TEXTBUFFER tb, int p) {
+ return static_cast<Fl_Text_Buffer*>(tb)->line_text(p);
+}
+
+int fl_text_buffer_skip_lines(TEXTBUFFER tb, int s, int l) {
+ return static_cast<Fl_Text_Buffer*>(tb)->skip_lines(s, l);
+}
+
+int fl_text_buffer_rewind_lines(TEXTBUFFER tb, int s, int l) {
+ return static_cast<Fl_Text_Buffer*>(tb)->rewind_lines(s, l);
+}
+
+int fl_text_buffer_skip_displayed_characters(TEXTBUFFER tb, int s, int n) {
+ return static_cast<Fl_Text_Buffer*>(tb)->skip_displayed_characters(s,n);
+}
+
+
+
+
+void fl_text_buffer_canundo(TEXTBUFFER tb, char f) {
+ return static_cast<Fl_Text_Buffer*>(tb)->canUndo(f);
+}
+
+void fl_text_buffer_copy(TEXTBUFFER tb, TEXTBUFFER tb2, int s, int f, int i) {
+ static_cast<Fl_Text_Buffer*>(tb)->copy(static_cast<Fl_Text_Buffer*>(tb2),s,f,i);
+}
+
+int fl_text_buffer_utf8_align(TEXTBUFFER tb, int p) {
+ return static_cast<Fl_Text_Buffer*>(tb)->utf8_align(p);
+}
+
+
diff --git a/body/c_fl_text_buffer.h b/body/c_fl_text_buffer.h
new file mode 100644
index 0000000..ce4c262
--- /dev/null
+++ b/body/c_fl_text_buffer.h
@@ -0,0 +1,100 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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 upref_fl_text_buffer(TEXTBUFFER tb);
+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" int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n, int b);
+extern "C" int fl_text_buffer_appendfile(TEXTBUFFER tb, char * n, int b);
+extern "C" int fl_text_buffer_insertfile(TEXTBUFFER tb, char * n, int p, int b);
+extern "C" int fl_text_buffer_outputfile(TEXTBUFFER tb, char * n, int f, int t, int b);
+extern "C" int fl_text_buffer_savefile(TEXTBUFFER tb, char * n, int b);
+
+
+extern "C" void fl_text_buffer_insert(TEXTBUFFER tb, int p, const char * item);
+extern "C" void fl_text_buffer_append(TEXTBUFFER tb, const char * item);
+extern "C" void fl_text_buffer_replace(TEXTBUFFER tb, int s, int f, const char * text);
+extern "C" void fl_text_buffer_remove(TEXTBUFFER tb, int s, int f);
+extern "C" char * fl_text_buffer_get_text(TEXTBUFFER tb);
+extern "C" void fl_text_buffer_set_text(TEXTBUFFER tb, char * t);
+extern "C" char fl_text_buffer_byte_at(TEXTBUFFER tb, int p);
+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);
+extern "C" int fl_text_buffer_next_char(TEXTBUFFER tb, int p);
+extern "C" int fl_text_buffer_prev_char(TEXTBUFFER tb, int p);
+
+
+extern "C" int fl_text_buffer_count_displayed_characters(TEXTBUFFER tb, int s, int f);
+extern "C" int fl_text_buffer_count_lines(TEXTBUFFER tb, int s, int f);
+extern "C" int fl_text_buffer_length(TEXTBUFFER tb);
+extern "C" int fl_text_buffer_get_tab_distance(TEXTBUFFER tb);
+extern "C" void fl_text_buffer_set_tab_distance(TEXTBUFFER tb, int t);
+
+
+extern "C" int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e);
+extern "C" int fl_text_buffer_secondary_selection_position(TEXTBUFFER tb, int * s, int * e);
+extern "C" void fl_text_buffer_select(TEXTBUFFER tb, int s, int e);
+extern "C" void fl_text_buffer_secondary_select(TEXTBUFFER tb, int s, int e);
+extern "C" int fl_text_buffer_selected(TEXTBUFFER tb);
+extern "C" int fl_text_buffer_secondary_selected(TEXTBUFFER tb);
+extern "C" char * fl_text_buffer_selection_text(TEXTBUFFER tb);
+extern "C" char * fl_text_buffer_secondary_selection_text(TEXTBUFFER tb);
+extern "C" void fl_text_buffer_replace_selection(TEXTBUFFER tb, char * t);
+extern "C" void fl_text_buffer_replace_secondary_selection(TEXTBUFFER tb, char * t);
+extern "C" void fl_text_buffer_remove_selection(TEXTBUFFER tb);
+extern "C" void fl_text_buffer_remove_secondary_selection(TEXTBUFFER tb);
+extern "C" void fl_text_buffer_unselect(TEXTBUFFER tb);
+extern "C" void fl_text_buffer_secondary_unselect(TEXTBUFFER tb);
+
+
+extern "C" void fl_text_buffer_highlight(TEXTBUFFER tb, int f, int t);
+extern "C" char * fl_text_buffer_highlight_text(TEXTBUFFER tb);
+extern "C" void fl_text_buffer_unhighlight(TEXTBUFFER tb);
+
+
+extern "C" int fl_text_buffer_findchar_forward(TEXTBUFFER tb, int start,
+ unsigned int item, int * found);
+extern "C" int fl_text_buffer_findchar_backward(TEXTBUFFER tb, int start,
+ unsigned int item, int * found);
+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" int fl_text_buffer_word_start(TEXTBUFFER tb, int p);
+extern "C" int fl_text_buffer_word_end(TEXTBUFFER tb, int p);
+extern "C" int fl_text_buffer_line_start(TEXTBUFFER tb, int p);
+extern "C" int fl_text_buffer_line_end(TEXTBUFFER tb, int p);
+extern "C" char * fl_text_buffer_line_text(TEXTBUFFER tb, int p);
+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" int fl_text_buffer_skip_displayed_characters(TEXTBUFFER tb, int s, int n);
+
+
+extern "C" void fl_text_buffer_canundo(TEXTBUFFER tb, char f);
+extern "C" void fl_text_buffer_copy(TEXTBUFFER tb, TEXTBUFFER tb2, int s, int f, int i);
+extern "C" int fl_text_buffer_utf8_align(TEXTBUFFER tb, int p);
+
+
+#endif
+
+
diff --git a/body/c_fl_text_display.cpp b/body/c_fl_text_display.cpp
new file mode 100644
index 0000000..654d6ce
--- /dev/null
+++ b/body/c_fl_text_display.cpp
@@ -0,0 +1,339 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Text_Display.H>
+#include <FL/Fl_Text_Buffer.H>
+#include "c_fl_text_display.h"
+#include "c_fl_text_buffer.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Text_Display : public Fl_Text_Display {
+public:
+ using Fl_Text_Display::Fl_Text_Display;
+
+ friend void fl_text_display_draw(TEXTDISPLAY td);
+ friend int fl_text_display_handle(TEXTDISPLAY td, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Text_Display::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Text_Display::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label) {
+ My_Text_Display *td = new My_Text_Display(x, y, w, h, label);
+ return td;
+}
+
+void free_fl_text_display(TEXTDISPLAY td) {
+ delete static_cast<My_Text_Display*>(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 static_cast<Fl_Text_Display*>(td)->buffer();
+}
+
+void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb) {
+ static_cast<Fl_Text_Display*>(td)->buffer(static_cast<Fl_Text_Buffer*>(tb));
+}
+
+
+
+
+void fl_text_display_highlight_data(TEXTDISPLAY td, TEXTBUFFER tb, void * st, int len) {
+ static_cast<Fl_Text_Display*>(td)->highlight_data
+ (static_cast<Fl_Text_Buffer*>(tb),
+ static_cast<Fl_Text_Display::Style_Table_Entry*>(st),
+ len, 0, 0, 0);
+}
+
+void fl_text_display_highlight_data2(TEXTDISPLAY td, TEXTBUFFER tb, void * st, int len,
+ char us, void * cb, void * a)
+{
+ static_cast<Fl_Text_Display*>(td)->highlight_data
+ (static_cast<Fl_Text_Buffer*>(tb),
+ static_cast<Fl_Text_Display::Style_Table_Entry*>(st),
+ len, us, reinterpret_cast<Fl_Text_Display::Unfinished_Style_Cb>(cb), a);
+}
+
+
+
+
+double fl_text_display_col_to_x(TEXTDISPLAY td, double c) {
+ return static_cast<Fl_Text_Display*>(td)->col_to_x(c);
+}
+
+double fl_text_display_x_to_col(TEXTDISPLAY td, double x) {
+ return static_cast<Fl_Text_Display*>(td)->x_to_col(x);
+}
+
+int fl_text_display_in_selection(TEXTDISPLAY td, int x, int y) {
+ return static_cast<Fl_Text_Display*>(td)->in_selection(x, y);
+}
+
+int fl_text_display_position_to_xy(TEXTDISPLAY td, int p, int * x, int * y) {
+ return static_cast<Fl_Text_Display*>(td)->position_to_xy(p, x, y);
+}
+
+
+
+
+unsigned int fl_text_display_get_cursor_color(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->cursor_color();
+}
+
+void fl_text_display_set_cursor_color(TEXTDISPLAY td, unsigned int c) {
+ static_cast<Fl_Text_Display*>(td)->cursor_color(c);
+}
+
+void fl_text_display_set_cursor_style(TEXTDISPLAY td, int s) {
+ static_cast<Fl_Text_Display*>(td)->cursor_style(s);
+}
+
+void fl_text_display_hide_cursor(TEXTDISPLAY td) {
+ static_cast<Fl_Text_Display*>(td)->hide_cursor();
+}
+
+void fl_text_display_show_cursor(TEXTDISPLAY td) {
+ static_cast<Fl_Text_Display*>(td)->show_cursor();
+}
+
+
+
+
+unsigned int fl_text_display_get_text_color(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->textcolor();
+}
+
+void fl_text_display_set_text_color(TEXTDISPLAY td, unsigned int c) {
+ static_cast<Fl_Text_Display*>(td)->textcolor(static_cast<Fl_Color>(c));
+}
+
+int fl_text_display_get_text_font(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->textfont();
+}
+
+void fl_text_display_set_text_font(TEXTDISPLAY td, int f) {
+ static_cast<Fl_Text_Display*>(td)->textfont(static_cast<Fl_Font>(f));
+}
+
+int fl_text_display_get_text_size(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->textsize();
+}
+
+void fl_text_display_set_text_size(TEXTDISPLAY td, int s) {
+ static_cast<Fl_Text_Display*>(td)->textsize(static_cast<Fl_Fontsize>(s));
+}
+
+
+
+
+void fl_text_display_insert(TEXTDISPLAY td, char * i) {
+ static_cast<Fl_Text_Display*>(td)->insert(i);
+}
+
+void fl_text_display_overstrike(TEXTDISPLAY td, char * t) {
+ static_cast<Fl_Text_Display*>(td)->overstrike(t);
+}
+
+int fl_text_display_get_insert_pos(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->insert_position();
+}
+
+void fl_text_display_set_insert_pos(TEXTDISPLAY td, int p) {
+ static_cast<Fl_Text_Display*>(td)->insert_position(p);
+}
+
+void fl_text_display_show_insert_pos(TEXTDISPLAY td) {
+ static_cast<Fl_Text_Display*>(td)->show_insert_position();
+}
+
+
+
+
+int fl_text_display_word_start(TEXTDISPLAY td, int p) {
+ return static_cast<Fl_Text_Display*>(td)->word_start(p);
+}
+
+int fl_text_display_word_end(TEXTDISPLAY td, int p) {
+ return static_cast<Fl_Text_Display*>(td)->word_end(p);
+}
+
+void fl_text_display_next_word(TEXTDISPLAY td) {
+ static_cast<Fl_Text_Display*>(td)->next_word();
+}
+
+void fl_text_display_previous_word(TEXTDISPLAY td) {
+ static_cast<Fl_Text_Display*>(td)->previous_word();
+}
+
+void fl_text_display_wrap_mode(TEXTDISPLAY td, int w, int m) {
+ static_cast<Fl_Text_Display*>(td)->wrap_mode(w, m);
+}
+
+
+
+
+int fl_text_display_line_start(TEXTDISPLAY td, int s) {
+ return static_cast<Fl_Text_Display*>(td)->line_start(s);
+}
+
+int fl_text_display_line_end(TEXTDISPLAY td, int s, int p) {
+ return static_cast<Fl_Text_Display*>(td)->line_end(s, p);
+}
+
+int fl_text_display_count_lines(TEXTDISPLAY td, int s, int f, int p) {
+ return static_cast<Fl_Text_Display*>(td)->count_lines(s, f, p);
+}
+
+int fl_text_display_skip_lines(TEXTDISPLAY td, int s, int l, int p) {
+ return static_cast<Fl_Text_Display*>(td)->skip_lines(s, l, p);
+}
+
+int fl_text_display_rewind_lines(TEXTDISPLAY td, int s, int l) {
+ return static_cast<Fl_Text_Display*>(td)->rewind_lines(s, l);
+}
+
+
+
+
+unsigned int fl_text_display_get_linenumber_align(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->linenumber_align();
+}
+
+void fl_text_display_set_linenumber_align(TEXTDISPLAY td, unsigned int a) {
+ static_cast<Fl_Text_Display*>(td)->linenumber_align(a);
+}
+
+unsigned int fl_text_display_get_linenumber_bgcolor(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->linenumber_bgcolor();
+}
+
+void fl_text_display_set_linenumber_bgcolor(TEXTDISPLAY td, unsigned int c) {
+ static_cast<Fl_Text_Display*>(td)->linenumber_bgcolor(c);
+}
+
+unsigned int fl_text_display_get_linenumber_fgcolor(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->linenumber_fgcolor();
+}
+
+void fl_text_display_set_linenumber_fgcolor(TEXTDISPLAY td, unsigned int c) {
+ static_cast<Fl_Text_Display*>(td)->linenumber_fgcolor(c);
+}
+
+int fl_text_display_get_linenumber_font(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->linenumber_font();
+}
+
+void fl_text_display_set_linenumber_font(TEXTDISPLAY td, int f) {
+ static_cast<Fl_Text_Display*>(td)->linenumber_font(f);
+}
+
+int fl_text_display_get_linenumber_size(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->linenumber_size();
+}
+
+void fl_text_display_set_linenumber_size(TEXTDISPLAY td, int s) {
+ static_cast<Fl_Text_Display*>(td)->linenumber_size(s);
+}
+
+int fl_text_display_get_linenumber_width(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->linenumber_width();
+}
+
+void fl_text_display_set_linenumber_width(TEXTDISPLAY td, int w) {
+ static_cast<Fl_Text_Display*>(td)->linenumber_width(w);
+}
+
+
+
+
+int fl_text_display_move_down(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->move_down();
+}
+
+int fl_text_display_move_left(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->move_left();
+}
+
+int fl_text_display_move_right(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->move_right();
+}
+
+int fl_text_display_move_up(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->move_up();
+}
+
+
+
+
+void fl_text_display_scroll(TEXTDISPLAY td, int l) {
+ static_cast<Fl_Text_Display*>(td)->scroll(l, 1);
+}
+
+unsigned int fl_text_display_get_scrollbar_align(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->scrollbar_align();
+}
+
+void fl_text_display_set_scrollbar_align(TEXTDISPLAY td, unsigned int a) {
+ static_cast<Fl_Text_Display*>(td)->scrollbar_align(a);
+}
+
+int fl_text_display_get_scrollbar_width(TEXTDISPLAY td) {
+ return static_cast<Fl_Text_Display*>(td)->scrollbar_width();
+}
+
+void fl_text_display_set_scrollbar_width(TEXTDISPLAY td, int w) {
+ static_cast<Fl_Text_Display*>(td)->scrollbar_width(w);
+}
+
+
+
+
+void fl_text_display_redisplay_range(TEXTDISPLAY td, int s, int f) {
+ static_cast<Fl_Text_Display*>(td)->redisplay_range(s,f);
+}
+
+
+
+
+void fl_text_display_draw(TEXTDISPLAY td) {
+ static_cast<My_Text_Display*>(td)->Fl_Text_Display::draw();
+}
+
+int fl_text_display_handle(TEXTDISPLAY td, int e) {
+ return static_cast<My_Text_Display*>(td)->Fl_Text_Display::handle(e);
+}
+
+
diff --git a/body/c_fl_text_display.h b/body/c_fl_text_display.h
new file mode 100644
index 0000000..ece9a6a
--- /dev/null
+++ b/body/c_fl_text_display.h
@@ -0,0 +1,107 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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" void fl_text_display_highlight_data(TEXTDISPLAY td, TEXTBUFFER tb, void * st, int len);
+extern "C" void fl_text_display_highlight_data2(TEXTDISPLAY td, TEXTBUFFER tb, void * st, int len,
+ char us, void * cb, void * a);
+
+
+extern "C" double fl_text_display_col_to_x(TEXTDISPLAY td, double c);
+extern "C" double fl_text_display_x_to_col(TEXTDISPLAY td, double x);
+extern "C" int fl_text_display_in_selection(TEXTDISPLAY td, int x, int y);
+extern "C" int fl_text_display_position_to_xy(TEXTDISPLAY td, int p, int * x, int * y);
+
+
+extern "C" unsigned int fl_text_display_get_cursor_color(TEXTDISPLAY td);
+extern "C" void fl_text_display_set_cursor_color(TEXTDISPLAY td, unsigned int c);
+extern "C" void fl_text_display_set_cursor_style(TEXTDISPLAY td, int s);
+extern "C" void fl_text_display_hide_cursor(TEXTDISPLAY td);
+extern "C" void fl_text_display_show_cursor(TEXTDISPLAY td);
+
+
+extern "C" unsigned int fl_text_display_get_text_color(TEXTDISPLAY td);
+extern "C" void fl_text_display_set_text_color(TEXTDISPLAY td, unsigned 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" void fl_text_display_insert(TEXTDISPLAY td, char * i);
+extern "C" void fl_text_display_overstrike(TEXTDISPLAY td, char * t);
+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" int fl_text_display_word_start(TEXTDISPLAY td, int p);
+extern "C" int fl_text_display_word_end(TEXTDISPLAY td, int p);
+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_line_start(TEXTDISPLAY td, int s);
+extern "C" int fl_text_display_line_end(TEXTDISPLAY td, int s, int p);
+extern "C" int fl_text_display_count_lines(TEXTDISPLAY td, int s, int f, int p);
+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" unsigned int fl_text_display_get_linenumber_align(TEXTDISPLAY td);
+extern "C" void fl_text_display_set_linenumber_align(TEXTDISPLAY td, unsigned int a);
+extern "C" unsigned int fl_text_display_get_linenumber_bgcolor(TEXTDISPLAY td);
+extern "C" void fl_text_display_set_linenumber_bgcolor(TEXTDISPLAY td, unsigned int c);
+extern "C" unsigned int fl_text_display_get_linenumber_fgcolor(TEXTDISPLAY td);
+extern "C" void fl_text_display_set_linenumber_fgcolor(TEXTDISPLAY td, unsigned int c);
+extern "C" int fl_text_display_get_linenumber_font(TEXTDISPLAY td);
+extern "C" void fl_text_display_set_linenumber_font(TEXTDISPLAY td, int f);
+extern "C" int fl_text_display_get_linenumber_size(TEXTDISPLAY td);
+extern "C" void fl_text_display_set_linenumber_size(TEXTDISPLAY td, int s);
+extern "C" int fl_text_display_get_linenumber_width(TEXTDISPLAY td);
+extern "C" void fl_text_display_set_linenumber_width(TEXTDISPLAY td, int w);
+
+
+extern "C" int fl_text_display_move_down(TEXTDISPLAY td);
+extern "C" int fl_text_display_move_left(TEXTDISPLAY td);
+extern "C" int fl_text_display_move_right(TEXTDISPLAY td);
+extern "C" int fl_text_display_move_up(TEXTDISPLAY td);
+
+
+extern "C" void fl_text_display_scroll(TEXTDISPLAY td, int l);
+extern "C" unsigned int fl_text_display_get_scrollbar_align(TEXTDISPLAY td);
+extern "C" void fl_text_display_set_scrollbar_align(TEXTDISPLAY td, unsigned int a);
+extern "C" int fl_text_display_get_scrollbar_width(TEXTDISPLAY td);
+extern "C" void fl_text_display_set_scrollbar_width(TEXTDISPLAY td, int w);
+
+
+extern "C" void fl_text_display_redisplay_range(TEXTDISPLAY td, int s, int f);
+
+
+extern "C" void fl_text_display_draw(TEXTDISPLAY td);
+extern "C" int fl_text_display_handle(TEXTDISPLAY td, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_text_editor.cpp b/body/c_fl_text_editor.cpp
new file mode 100644
index 0000000..6138cb2
--- /dev/null
+++ b/body/c_fl_text_editor.cpp
@@ -0,0 +1,398 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Text_Editor.H>
+#include "c_fl_text_editor.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Text_Editor : Fl_Text_Editor {
+public:
+ using Fl_Text_Editor::handle_key;
+ using Fl_Text_Editor::maybe_do_callback;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Text_Editor : public Fl_Text_Editor {
+public:
+ using Fl_Text_Editor::Fl_Text_Editor;
+
+ friend void fl_text_editor_draw(TEXTEDITOR te);
+ friend int fl_text_editor_handle(TEXTEDITOR te, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Text_Editor::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Text_Editor::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label) {
+ My_Text_Editor *te = new My_Text_Editor(x, y, w, h, label);
+ return te;
+}
+
+void free_fl_text_editor(TEXTEDITOR te) {
+ delete static_cast<My_Text_Editor*>(te);
+}
+
+
+
+
+void fl_text_editor_default(TEXTEDITOR te, int k) {
+ Fl_Text_Editor::kf_default(k, static_cast<Fl_Text_Editor*>(te));
+}
+
+
+
+
+void fl_text_editor_undo(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_undo(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_cut(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_cut(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_copy(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_copy(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_paste(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_paste(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_delete(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_delete(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_select_all(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_select_all(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+
+
+
+void fl_text_editor_backspace(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_backspace(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_insert(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_insert(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_enter(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_enter(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ignore(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_ignore(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+
+
+
+void fl_text_editor_home(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_home(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_end(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_end(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_page_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_page_down(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_page_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_page_up(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_down(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_left(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_left(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_right(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_right(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_up(0, static_cast<Fl_Text_Editor*>(te));
+}
+
+
+
+
+void fl_text_editor_shift_home(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_shift_move(FL_Home, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_shift_end(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_shift_move(FL_End, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_shift_page_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_shift_move(FL_Page_Down, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_shift_page_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_shift_move(FL_Page_Up, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_shift_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_shift_move(FL_Down, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_shift_left(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_shift_move(FL_Left, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_shift_right(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_shift_move(FL_Right, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_shift_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_shift_move(FL_Up, static_cast<Fl_Text_Editor*>(te));
+}
+
+
+
+
+void fl_text_editor_ctrl_home(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_ctrl_move(FL_Home, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_end(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_ctrl_move(FL_End, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_page_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_ctrl_move(FL_Page_Down, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_page_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_ctrl_move(FL_Page_Up, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_ctrl_move(FL_Down, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_left(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_ctrl_move(FL_Left, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_right(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_ctrl_move(FL_Right, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_ctrl_move(FL_Up, static_cast<Fl_Text_Editor*>(te));
+}
+
+
+
+
+void fl_text_editor_ctrl_shift_home(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_c_s_move(FL_Home, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_shift_end(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_c_s_move(FL_End, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_shift_page_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_c_s_move(FL_Page_Down, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_shift_page_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_c_s_move(FL_Page_Up, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_shift_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_c_s_move(FL_Down, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_shift_left(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_c_s_move(FL_Left, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_shift_right(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_c_s_move(FL_Right, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_ctrl_shift_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_c_s_move(FL_Up, static_cast<Fl_Text_Editor*>(te));
+}
+
+
+
+
+void fl_text_editor_meta_home(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_meta_move(FL_Home, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_end(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_meta_move(FL_End, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_page_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_meta_move(FL_Page_Down, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_page_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_meta_move(FL_Page_Up, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_meta_move(FL_Down, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_left(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_meta_move(FL_Left, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_right(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_meta_move(FL_Right, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_meta_move(FL_Up, static_cast<Fl_Text_Editor*>(te));
+}
+
+
+
+
+void fl_text_editor_meta_shift_home(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_m_s_move(FL_Home, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_shift_end(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_m_s_move(FL_End, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_shift_page_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_m_s_move(FL_Page_Down, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_shift_page_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_m_s_move(FL_Page_Up, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_shift_down(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_m_s_move(FL_Down, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_shift_left(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_m_s_move(FL_Left, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_shift_right(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_m_s_move(FL_Right, static_cast<Fl_Text_Editor*>(te));
+}
+
+void fl_text_editor_meta_shift_up(TEXTEDITOR te) {
+ Fl_Text_Editor::kf_m_s_move(FL_Up, static_cast<Fl_Text_Editor*>(te));
+}
+
+
+
+
+void fl_text_editor_add_key_binding(TEXTEDITOR te, int k, int s, void * f) {
+ static_cast<Fl_Text_Editor*>(te)->add_key_binding
+ (k, s, reinterpret_cast<Fl_Text_Editor::Key_Func>(f));
+}
+
+void fl_text_editor_remove_all_key_bindings(TEXTEDITOR te) {
+ static_cast<Fl_Text_Editor*>(te)->remove_all_key_bindings();
+}
+
+void fl_text_editor_set_default_key_function(TEXTEDITOR te, void * f) {
+ static_cast<Fl_Text_Editor*>(te)->default_key_function
+ (reinterpret_cast<Fl_Text_Editor::Key_Func>(f));
+}
+
+
+
+
+int fl_text_editor_get_insert_mode(TEXTEDITOR te) {
+ return static_cast<Fl_Text_Editor*>(te)->insert_mode();
+}
+
+void fl_text_editor_set_insert_mode(TEXTEDITOR te, int i) {
+ static_cast<Fl_Text_Editor*>(te)->insert_mode(i);
+}
+
+
+
+
+int fl_text_editor_get_tab_nav(TEXTEDITOR te) {
+#if FLTK_ABI_VERSION >= 10304
+ return static_cast<Fl_Text_Editor*>(te)->tab_nav();
+#else
+ (void)(te);
+ return 0;
+#endif
+}
+
+void fl_text_editor_set_tab_nav(TEXTEDITOR te, int t) {
+#if FLTK_ABI_VERSION >= 10304
+ static_cast<Fl_Text_Editor*>(te)->tab_nav(t);
+#else
+ (void)(te);
+ (void)(t);
+#endif
+}
+
+
+
+
+void fl_text_editor_draw(TEXTEDITOR te) {
+ static_cast<My_Text_Editor*>(te)->Fl_Text_Editor::draw();
+}
+
+int fl_text_editor_handle(TEXTEDITOR te, int e) {
+ return static_cast<My_Text_Editor*>(te)->Fl_Text_Editor::handle(e);
+}
+
+int fl_text_editor_handle_key(TEXTEDITOR te) {
+ return (static_cast<Fl_Text_Editor*>(te)->*(&Friend_Text_Editor::handle_key))();
+}
+
+void fl_text_editor_maybe_do_callback(TEXTEDITOR te) {
+ (static_cast<Fl_Text_Editor*>(te)->*(&Friend_Text_Editor::maybe_do_callback))();
+}
+
+
diff --git a/body/c_fl_text_editor.h b/body/c_fl_text_editor.h
new file mode 100644
index 0000000..3f57921
--- /dev/null
+++ b/body/c_fl_text_editor.h
@@ -0,0 +1,116 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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_default(TEXTEDITOR te, int k);
+
+
+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_select_all(TEXTEDITOR te);
+
+
+extern "C" void fl_text_editor_backspace(TEXTEDITOR te);
+extern "C" void fl_text_editor_insert(TEXTEDITOR te);
+extern "C" void fl_text_editor_enter(TEXTEDITOR te);
+extern "C" void fl_text_editor_ignore(TEXTEDITOR te);
+
+
+extern "C" void fl_text_editor_home(TEXTEDITOR te);
+extern "C" void fl_text_editor_end(TEXTEDITOR te);
+extern "C" void fl_text_editor_page_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_page_up(TEXTEDITOR te);
+extern "C" void fl_text_editor_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_left(TEXTEDITOR te);
+extern "C" void fl_text_editor_right(TEXTEDITOR te);
+extern "C" void fl_text_editor_up(TEXTEDITOR te);
+
+
+extern "C" void fl_text_editor_shift_home(TEXTEDITOR te);
+extern "C" void fl_text_editor_shift_end(TEXTEDITOR te);
+extern "C" void fl_text_editor_shift_page_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_shift_page_up(TEXTEDITOR te);
+extern "C" void fl_text_editor_shift_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_shift_left(TEXTEDITOR te);
+extern "C" void fl_text_editor_shift_right(TEXTEDITOR te);
+extern "C" void fl_text_editor_shift_up(TEXTEDITOR te);
+
+
+extern "C" void fl_text_editor_ctrl_home(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_end(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_page_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_page_up(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_left(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_right(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_up(TEXTEDITOR te);
+
+
+extern "C" void fl_text_editor_ctrl_shift_home(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_shift_end(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_shift_page_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_shift_page_up(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_shift_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_shift_left(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_shift_right(TEXTEDITOR te);
+extern "C" void fl_text_editor_ctrl_shift_up(TEXTEDITOR te);
+
+
+extern "C" void fl_text_editor_meta_home(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_end(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_page_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_page_up(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_left(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_right(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_up(TEXTEDITOR te);
+
+
+extern "C" void fl_text_editor_meta_shift_home(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_shift_end(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_shift_page_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_shift_page_up(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_shift_down(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_shift_left(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_shift_right(TEXTEDITOR te);
+extern "C" void fl_text_editor_meta_shift_up(TEXTEDITOR te);
+
+
+extern "C" void fl_text_editor_add_key_binding(TEXTEDITOR te, int k, int s, void * f);
+extern "C" void fl_text_editor_remove_all_key_bindings(TEXTEDITOR te);
+extern "C" void fl_text_editor_set_default_key_function(TEXTEDITOR te, void * f);
+
+
+extern "C" int fl_text_editor_get_insert_mode(TEXTEDITOR te);
+extern "C" void fl_text_editor_set_insert_mode(TEXTEDITOR te, int i);
+
+
+extern "C" int fl_text_editor_get_tab_nav(TEXTEDITOR te);
+extern "C" void fl_text_editor_set_tab_nav(TEXTEDITOR te, int t);
+
+
+extern "C" void fl_text_editor_draw(TEXTEDITOR te);
+extern "C" int fl_text_editor_handle(TEXTEDITOR te, int e);
+extern "C" int fl_text_editor_handle_key(TEXTEDITOR te);
+extern "C" void fl_text_editor_maybe_do_callback(TEXTEDITOR te);
+
+
+#endif
+
+
diff --git a/body/c_fl_tile.cpp b/body/c_fl_tile.cpp
new file mode 100644
index 0000000..81f820a
--- /dev/null
+++ b/body/c_fl_tile.cpp
@@ -0,0 +1,78 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Tile.H>
+#include "c_fl_tile.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Tile : public Fl_Tile {
+public:
+ using Fl_Tile::Fl_Tile;
+
+ friend void fl_tile_draw(TILE n);
+ friend int fl_tile_handle(TILE n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Tile::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Tile::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+TILE new_fl_tile(int x, int y, int w, int h, char* label) {
+ My_Tile *b = new My_Tile(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_tile(TILE t) {
+ delete static_cast<My_Tile*>(t);
+}
+
+
+
+
+void fl_tile_position(TILE t, int ox, int oy, int nx, int ny) {
+ static_cast<Fl_Tile*>(t)->position(ox,oy,nx,ny);
+}
+
+void fl_tile_resize(TILE t, int x, int y, int w, int h) {
+ static_cast<Fl_Tile*>(t)->resize(x, y, w, h);
+}
+
+
+
+
+void fl_tile_draw(TILE n) {
+ static_cast<My_Tile*>(n)->Fl_Tile::draw();
+}
+
+int fl_tile_handle(TILE n, int e) {
+ return static_cast<My_Tile*>(n)->Fl_Tile::handle(e);
+}
+
+
diff --git a/body/c_fl_tile.h b/body/c_fl_tile.h
new file mode 100644
index 0000000..3254558
--- /dev/null
+++ b/body/c_fl_tile.h
@@ -0,0 +1,28 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_TILE_GUARD
+#define FL_TILE_GUARD
+
+
+typedef void* TILE;
+
+
+extern "C" TILE new_fl_tile(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_tile(TILE t);
+
+
+extern "C" void fl_tile_position(TILE t, int ox, int oy, int nx, int ny);
+extern "C" void fl_tile_resize(TILE t, int x, int y, int w, int h);
+
+
+extern "C" void fl_tile_draw(TILE n);
+extern "C" int fl_tile_handle(TILE n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_tiled_image.cpp b/body/c_fl_tiled_image.cpp
new file mode 100644
index 0000000..0fbea0f
--- /dev/null
+++ b/body/c_fl_tiled_image.cpp
@@ -0,0 +1,64 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Tiled_Image.H>
+#include <FL/Fl_Image.H>
+#include "c_fl_tiled_image.h"
+
+
+
+
+TILEDIMAGE new_fl_tiled_image(void * i, int w, int h) {
+ Fl_Tiled_Image *t = new Fl_Tiled_Image(static_cast<Fl_Image*>(i), w, h);
+ return t;
+}
+
+void free_fl_tiled_image(TILEDIMAGE t) {
+ delete static_cast<Fl_Tiled_Image*>(t);
+}
+
+TILEDIMAGE fl_tiled_image_copy(TILEDIMAGE t, int w, int h) {
+ // virtual so disable dispatch
+ return static_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::copy(w, h);
+}
+
+TILEDIMAGE fl_tiled_image_copy2(TILEDIMAGE t) {
+ return static_cast<Fl_Tiled_Image*>(t)->copy();
+}
+
+
+
+
+void * fl_tiled_image_get_image(TILEDIMAGE t) {
+ return static_cast<Fl_Tiled_Image*>(t)->image();
+}
+
+
+
+
+void fl_tiled_image_color_average(TILEDIMAGE t, int c, float b) {
+ // virtual so disable dispatch
+ static_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::color_average(c, b);
+}
+
+void fl_tiled_image_desaturate(TILEDIMAGE t) {
+ // virtual so disable dispatch
+ static_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::desaturate();
+}
+
+
+
+
+void fl_tiled_image_draw(TILEDIMAGE t, int x, int y) {
+ static_cast<Fl_Tiled_Image*>(t)->draw(x, y);
+}
+
+void fl_tiled_image_draw2(TILEDIMAGE t, int x, int y, int w, int h, int cx, int cy) {
+ // virtual so disable dispatch
+ static_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::draw(x, y, w, h, cx, cy);
+}
+
+
diff --git a/body/c_fl_tiled_image.h b/body/c_fl_tiled_image.h
new file mode 100644
index 0000000..9eee3dd
--- /dev/null
+++ b/body/c_fl_tiled_image.h
@@ -0,0 +1,33 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_TILED_IMAGE_GUARD
+#define FL_TILED_IMAGE_GUARD
+
+
+typedef void* TILEDIMAGE;
+
+
+extern "C" TILEDIMAGE new_fl_tiled_image(void * i, int w, int h);
+extern "C" void free_fl_tiled_image(TILEDIMAGE t);
+extern "C" TILEDIMAGE fl_tiled_image_copy(TILEDIMAGE t, int w, int h);
+extern "C" TILEDIMAGE fl_tiled_image_copy2(TILEDIMAGE t);
+
+
+extern "C" void * fl_tiled_image_get_image(TILEDIMAGE t);
+
+
+extern "C" void fl_tiled_image_color_average(TILEDIMAGE t, int c, float b);
+extern "C" void fl_tiled_image_desaturate(TILEDIMAGE t);
+
+
+extern "C" void fl_tiled_image_draw(TILEDIMAGE t, int x, int y);
+extern "C" void fl_tiled_image_draw2(TILEDIMAGE t, int x, int y, int w, int h, int cx, int cy);
+
+
+#endif
+
+
diff --git a/body/c_fl_toggle_button.cpp b/body/c_fl_toggle_button.cpp
new file mode 100644
index 0000000..d396f37
--- /dev/null
+++ b/body/c_fl_toggle_button.cpp
@@ -0,0 +1,67 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Toggle_Button.H>
+#include "c_fl_toggle_button.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Toggle_Button : public Fl_Toggle_Button {
+public:
+ using Fl_Toggle_Button::Fl_Toggle_Button;
+
+ friend void fl_toggle_button_draw(TOGGLEBUTTON b);
+ friend int fl_toggle_button_handle(TOGGLEBUTTON b, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Toggle_Button::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Toggle_Button::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+TOGGLEBUTTON new_fl_toggle_button(int x, int y, int w, int h, char* label) {
+ My_Toggle_Button *b = new My_Toggle_Button(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_toggle_button(TOGGLEBUTTON b) {
+ delete static_cast<My_Toggle_Button*>(b);
+}
+
+
+
+
+void fl_toggle_button_draw(TOGGLEBUTTON b) {
+ static_cast<My_Toggle_Button*>(b)->Fl_Toggle_Button::draw();
+}
+
+int fl_toggle_button_handle(TOGGLEBUTTON b, int e) {
+ return static_cast<My_Toggle_Button*>(b)->Fl_Toggle_Button::handle(e);
+}
+
+
diff --git a/body/c_fl_toggle_button.h b/body/c_fl_toggle_button.h
new file mode 100644
index 0000000..bdb86b1
--- /dev/null
+++ b/body/c_fl_toggle_button.h
@@ -0,0 +1,24 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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);
+
+
+extern "C" void fl_toggle_button_draw(TOGGLEBUTTON b);
+extern "C" int fl_toggle_button_handle(TOGGLEBUTTON b, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_tooltip.cpp b/body/c_fl_tooltip.cpp
new file mode 100644
index 0000000..8819da4
--- /dev/null
+++ b/body/c_fl_tooltip.cpp
@@ -0,0 +1,131 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Tooltip.H>
+#include <FL/Fl_Widget.H>
+#include "c_fl_tooltip.h"
+
+
+
+
+void * fl_tooltip_get_current(void) {
+ return Fl_Tooltip::current();
+}
+
+void fl_tooltip_set_current(void * i) {
+ Fl_Tooltip::current(static_cast<Fl_Widget*>(i));
+}
+
+int fl_tooltip_enabled(void) {
+ return Fl_Tooltip::enabled();
+}
+
+void fl_tooltip_enable(int v) {
+ Fl_Tooltip::enable(v);
+}
+
+void fl_tooltip_disable() {
+ Fl_Tooltip::disable();
+}
+
+void fl_tooltip_enter_area(void * i, int x, int y, int w, int h, const char * t) {
+ Fl_Tooltip::enter_area(static_cast<Fl_Widget*>(i),x,y,w,h,t);
+}
+
+
+
+
+float fl_tooltip_get_delay(void) {
+ return Fl_Tooltip::delay();
+}
+
+void fl_tooltip_set_delay(float v) {
+ Fl_Tooltip::delay(v);
+}
+
+float fl_tooltip_get_hoverdelay(void) {
+ return Fl_Tooltip::hoverdelay();
+}
+
+void fl_tooltip_set_hoverdelay(float v) {
+ Fl_Tooltip::hoverdelay(v);
+}
+
+
+
+
+unsigned int fl_tooltip_get_color(void) {
+ return Fl_Tooltip::color();
+}
+
+void fl_tooltip_set_color(unsigned int v) {
+ Fl_Tooltip::color(v);
+}
+
+int fl_tooltip_get_margin_height(void) {
+ return Fl_Tooltip::margin_height();
+}
+
+void fl_tooltip_set_margin_height(int v) {
+#if FLTK_ABI_VERSION >= 10301
+ Fl_Tooltip::margin_height(v);
+#else
+ (void)(v);
+#endif
+}
+
+int fl_tooltip_get_margin_width(void) {
+ return Fl_Tooltip::margin_width();
+}
+
+void fl_tooltip_set_margin_width(int v) {
+#if FLTK_ABI_VERSION >= 10301
+ Fl_Tooltip::margin_width(v);
+#else
+ (void)(v);
+#endif
+}
+
+int fl_tooltip_get_wrap_width(void) {
+ return Fl_Tooltip::wrap_width();
+}
+
+void fl_tooltip_set_wrap_width(int v) {
+#if FLTK_ABI_VERSION >= 10301
+ Fl_Tooltip::wrap_width(v);
+#else
+ (void)(v);
+#endif
+}
+
+
+
+
+unsigned int fl_tooltip_get_textcolor(void) {
+ return Fl_Tooltip::textcolor();
+}
+
+void fl_tooltip_set_textcolor(unsigned int v) {
+ Fl_Tooltip::textcolor(v);
+}
+
+int fl_tooltip_get_font(void) {
+ return Fl_Tooltip::font();
+}
+
+void fl_tooltip_set_font(int v) {
+ Fl_Tooltip::font(v);
+}
+
+int fl_tooltip_get_size(void) {
+ return Fl_Tooltip::size();
+}
+
+void fl_tooltip_set_size(int v) {
+ Fl_Tooltip::size(v);
+}
+
+
diff --git a/body/c_fl_tooltip.h b/body/c_fl_tooltip.h
new file mode 100644
index 0000000..055a11f
--- /dev/null
+++ b/body/c_fl_tooltip.h
@@ -0,0 +1,45 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_TOOLTIP_GUARD
+#define FL_TOOLTIP_GUARD
+
+
+extern "C" void * fl_tooltip_get_current(void);
+extern "C" void fl_tooltip_set_current(void * i);
+extern "C" int fl_tooltip_enabled(void);
+extern "C" void fl_tooltip_enable(int v);
+extern "C" void fl_tooltip_disable();
+extern "C" void fl_tooltip_enter_area(void * i, int x, int y, int w, int h, const char * t);
+
+
+extern "C" float fl_tooltip_get_delay(void);
+extern "C" void fl_tooltip_set_delay(float v);
+extern "C" float fl_tooltip_get_hoverdelay(void);
+extern "C" void fl_tooltip_set_hoverdelay(float v);
+
+
+extern "C" unsigned int fl_tooltip_get_color(void);
+extern "C" void fl_tooltip_set_color(unsigned int v);
+extern "C" int fl_tooltip_get_margin_height(void);
+extern "C" void fl_tooltip_set_margin_height(int v);
+extern "C" int fl_tooltip_get_margin_width(void);
+extern "C" void fl_tooltip_set_margin_width(int v);
+extern "C" int fl_tooltip_get_wrap_width(void);
+extern "C" void fl_tooltip_set_wrap_width(int v);
+
+
+extern "C" unsigned int fl_tooltip_get_textcolor(void);
+extern "C" void fl_tooltip_set_textcolor(unsigned int v);
+extern "C" int fl_tooltip_get_font(void);
+extern "C" void fl_tooltip_set_font(int v);
+extern "C" int fl_tooltip_get_size(void);
+extern "C" void fl_tooltip_set_size(int v);
+
+
+#endif
+
+
diff --git a/body/c_fl_valuator.cpp b/body/c_fl_valuator.cpp
new file mode 100644
index 0000000..3b4ebba
--- /dev/null
+++ b/body/c_fl_valuator.cpp
@@ -0,0 +1,170 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Valuator.H>
+#include "c_fl_valuator.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Valuator : Fl_Valuator {
+public:
+ using Fl_Valuator::value_damage;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Valuator : public Fl_Valuator {
+public:
+ using Fl_Valuator::Fl_Valuator;
+ friend VALUATOR new_fl_valuator(int x, int y, int w, int h, char* label);
+
+ friend void fl_valuator_draw(VALUATOR v);
+ friend int fl_valuator_handle(VALUATOR v, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Valuator::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Valuator::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Valuator::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+VALUATOR new_fl_valuator(int x, int y, int w, int h, char* label) {
+ My_Valuator *v = new My_Valuator(x, y, w, h, label);
+ return v;
+}
+
+void free_fl_valuator(VALUATOR v) {
+ delete static_cast<My_Valuator*>(v);
+}
+
+
+
+
+int fl_valuator_format(VALUATOR v, char * buf) {
+ return static_cast<Fl_Valuator*>(v)->Fl_Valuator::format(buf);
+}
+
+
+
+
+double fl_valuator_clamp(VALUATOR v, double a) {
+ return static_cast<Fl_Valuator*>(v)->clamp(a);
+}
+
+double fl_valuator_round(VALUATOR v, double a) {
+ return static_cast<Fl_Valuator*>(v)->round(a);
+}
+
+double fl_valuator_increment(VALUATOR v, double a, int s) {
+ return static_cast<Fl_Valuator*>(v)->increment(a,s);
+}
+
+
+
+
+double fl_valuator_get_minimum(VALUATOR v) {
+ return static_cast<Fl_Valuator*>(v)->minimum();
+}
+
+void fl_valuator_set_minimum(VALUATOR v, double t) {
+ static_cast<Fl_Valuator*>(v)->minimum(t);
+}
+
+double fl_valuator_get_maximum(VALUATOR v) {
+ return static_cast<Fl_Valuator*>(v)->maximum();
+}
+
+void fl_valuator_set_maximum(VALUATOR v, double t) {
+ static_cast<Fl_Valuator*>(v)->maximum(t);
+}
+
+double fl_valuator_get_step(VALUATOR v) {
+ return static_cast<Fl_Valuator*>(v)->step();
+}
+
+void fl_valuator_set_step_top(VALUATOR v, double t) {
+ static_cast<Fl_Valuator*>(v)->step(t);
+}
+
+void fl_valuator_set_step_bottom(VALUATOR v, int b) {
+ static_cast<Fl_Valuator*>(v)->step(b);
+}
+
+void fl_valuator_set_step(VALUATOR v, double t, int b) {
+ static_cast<Fl_Valuator*>(v)->step(t, b);
+}
+
+double fl_valuator_get_value(VALUATOR v) {
+ return static_cast<Fl_Valuator*>(v)->value();
+}
+
+void fl_valuator_set_value(VALUATOR v, double t) {
+ static_cast<Fl_Valuator*>(v)->value(t);
+}
+
+void fl_valuator_bounds(VALUATOR v, double a, double b) {
+ static_cast<Fl_Valuator*>(v)->bounds(a,b);
+}
+
+void fl_valuator_precision(VALUATOR v, int s) {
+ static_cast<Fl_Valuator*>(v)->precision(s);
+}
+
+void fl_valuator_range(VALUATOR v, double a, double b) {
+ static_cast<Fl_Valuator*>(v)->range(a,b);
+}
+
+
+
+
+void fl_valuator_value_damage(VALUATOR v) {
+ (static_cast<Fl_Valuator*>(v)->*(&Friend_Valuator::value_damage))();
+}
+
+void fl_valuator_draw(VALUATOR v) {
+ // The Fl_Valuator draw method doesn't technically exist, so...
+ (void)(v);
+ // It is more convenient for this function to exist, however,
+ // even though it will likely never be called, because it simplifies
+ // and makes uniform the implementation of the Ada Valuator Draw subprogram.
+}
+
+int fl_valuator_handle(VALUATOR v, int e) {
+ return static_cast<My_Valuator*>(v)->Fl_Valuator::handle(e);
+}
+
+
diff --git a/body/c_fl_valuator.h b/body/c_fl_valuator.h
new file mode 100644
index 0000000..81107bc
--- /dev/null
+++ b/body/c_fl_valuator.h
@@ -0,0 +1,48 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_VALUATOR_GUARD
+#define FL_VALUATOR_GUARD
+
+
+typedef void* VALUATOR;
+
+
+extern "C" VALUATOR new_fl_valuator(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_valuator(VALUATOR v);
+
+
+extern "C" int fl_valuator_format(VALUATOR v, char * buf);
+
+
+extern "C" double fl_valuator_clamp(VALUATOR v, double a);
+extern "C" double fl_valuator_round(VALUATOR v, double a);
+extern "C" double fl_valuator_increment(VALUATOR v, double a, int s);
+
+
+extern "C" double fl_valuator_get_minimum(VALUATOR v);
+extern "C" void fl_valuator_set_minimum(VALUATOR v, double t);
+extern "C" double fl_valuator_get_maximum(VALUATOR v);
+extern "C" void fl_valuator_set_maximum(VALUATOR v, double t);
+extern "C" double fl_valuator_get_step(VALUATOR v);
+extern "C" void fl_valuator_set_step_top(VALUATOR v, double t);
+extern "C" void fl_valuator_set_step_bottom(VALUATOR v, int b);
+extern "C" void fl_valuator_set_step(VALUATOR v, double t, int b);
+extern "C" double fl_valuator_get_value(VALUATOR v);
+extern "C" void fl_valuator_set_value(VALUATOR v, double t);
+extern "C" void fl_valuator_bounds(VALUATOR v, double a, double b);
+extern "C" void fl_valuator_precision(VALUATOR v, int s);
+extern "C" void fl_valuator_range(VALUATOR v, double a, double b);
+
+
+extern "C" void fl_valuator_value_damage(VALUATOR v);
+extern "C" void fl_valuator_draw(VALUATOR v);
+extern "C" int fl_valuator_handle(VALUATOR v, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_value_input.cpp b/body/c_fl_value_input.cpp
new file mode 100644
index 0000000..3d19845
--- /dev/null
+++ b/body/c_fl_value_input.cpp
@@ -0,0 +1,148 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Value_Input.H>
+#include "c_fl_value_input.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Value_Input : public Fl_Value_Input {
+public:
+ using Fl_Value_Input::Fl_Value_Input;
+
+ friend void fl_value_input_draw(VALUEINPUT a);
+ friend int fl_value_input_handle(VALUEINPUT a, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Value_Input::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Value_Input::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Value_Input::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+VALUEINPUT new_fl_value_input(int x, int y, int w, int h, char* label) {
+ My_Value_Input *a = new My_Value_Input(x, y, w, h, label);
+ return a;
+}
+
+void free_fl_value_input(VALUEINPUT a) {
+ delete static_cast<My_Value_Input*>(a);
+}
+
+
+
+
+void * fl_value_input_get_input(VALUEINPUT v) {
+ return &(static_cast<Fl_Value_Input*>(v)->input);
+}
+
+
+
+
+unsigned int fl_value_input_get_cursor_color(VALUEINPUT v) {
+ return static_cast<Fl_Value_Input*>(v)->cursor_color();
+}
+
+void fl_value_input_set_cursor_color(VALUEINPUT v, unsigned int c) {
+ static_cast<Fl_Value_Input*>(v)->cursor_color(c);
+}
+
+
+
+
+int fl_value_input_get_shortcut(VALUEINPUT v) {
+ return static_cast<Fl_Value_Input*>(v)->Fl_Value_Input::shortcut();
+}
+
+void fl_value_input_set_shortcut(VALUEINPUT v, int k) {
+ static_cast<Fl_Value_Input*>(v)->Fl_Value_Input::shortcut(k);
+}
+
+
+
+
+int fl_value_input_is_soft(VALUEINPUT a) {
+ return static_cast<Fl_Value_Input*>(a)->soft();
+}
+
+void fl_value_input_set_soft(VALUEINPUT a, int t) {
+ static_cast<Fl_Value_Input*>(a)->soft(t);
+}
+
+
+
+
+unsigned int fl_value_input_get_text_color(VALUEINPUT v) {
+ return static_cast<Fl_Value_Input*>(v)->textcolor();
+}
+
+void fl_value_input_set_text_color(VALUEINPUT v, unsigned int c) {
+ static_cast<Fl_Value_Input*>(v)->textcolor(static_cast<Fl_Color>(c));
+}
+
+int fl_value_input_get_text_font(VALUEINPUT v) {
+ return static_cast<Fl_Value_Input*>(v)->textfont();
+}
+
+void fl_value_input_set_text_font(VALUEINPUT v, int f) {
+ static_cast<Fl_Value_Input*>(v)->textfont(static_cast<Fl_Font>(f));
+}
+
+int fl_value_input_get_text_size(VALUEINPUT v) {
+ return static_cast<Fl_Value_Input*>(v)->textsize();
+}
+
+void fl_value_input_set_text_size(VALUEINPUT v, int s) {
+ static_cast<Fl_Value_Input*>(v)->textsize(static_cast<Fl_Fontsize>(s));
+}
+
+
+
+
+void fl_value_input_resize(VALUEINPUT v, int x, int y, int w, int h) {
+ static_cast<Fl_Value_Input*>(v)->resize(x, y, w, h);
+}
+
+
+
+
+void fl_value_input_draw(VALUEINPUT a) {
+ static_cast<My_Value_Input*>(a)->Fl_Value_Input::draw();
+}
+
+int fl_value_input_handle(VALUEINPUT a, int e) {
+ return static_cast<My_Value_Input*>(a)->Fl_Value_Input::handle(e);
+}
+
+
diff --git a/body/c_fl_value_input.h b/body/c_fl_value_input.h
new file mode 100644
index 0000000..f9eeff2
--- /dev/null
+++ b/body/c_fl_value_input.h
@@ -0,0 +1,50 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_VALUE_INPUT_GUARD
+#define FL_VALUE_INPUT_GUARD
+
+
+typedef void* VALUEINPUT;
+
+
+extern "C" VALUEINPUT new_fl_value_input(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_value_input(VALUEINPUT a);
+
+
+extern "C" void * fl_value_input_get_input(VALUEINPUT v);
+
+
+extern "C" unsigned int fl_value_input_get_cursor_color(VALUEINPUT v);
+extern "C" void fl_value_input_set_cursor_color(VALUEINPUT v, unsigned int c);
+
+
+extern "C" int fl_value_input_get_shortcut(VALUEINPUT v);
+extern "C" void fl_value_input_set_shortcut(VALUEINPUT v, int k);
+
+
+extern "C" int fl_value_input_is_soft(VALUEINPUT a);
+extern "C" void fl_value_input_set_soft(VALUEINPUT a, int t);
+
+
+extern "C" unsigned int fl_value_input_get_text_color(VALUEINPUT v);
+extern "C" void fl_value_input_set_text_color(VALUEINPUT v, unsigned int c);
+extern "C" int fl_value_input_get_text_font(VALUEINPUT v);
+extern "C" void fl_value_input_set_text_font(VALUEINPUT v, int f);
+extern "C" int fl_value_input_get_text_size(VALUEINPUT v);
+extern "C" void fl_value_input_set_text_size(VALUEINPUT v, int s);
+
+
+extern "C" void fl_value_input_resize(VALUEINPUT v, int x, int y, int w, int h);
+
+
+extern "C" void fl_value_input_draw(VALUEINPUT a);
+extern "C" int fl_value_input_handle(VALUEINPUT a, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_value_output.cpp b/body/c_fl_value_output.cpp
new file mode 100644
index 0000000..5e42996
--- /dev/null
+++ b/body/c_fl_value_output.cpp
@@ -0,0 +1,112 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Value_Output.H>
+#include "c_fl_value_output.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Value_Output : public Fl_Value_Output {
+public:
+ using Fl_Value_Output::Fl_Value_Output;
+
+ friend void fl_value_output_draw(VALUEOUTPUT a);
+ friend int fl_value_output_handle(VALUEOUTPUT a, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Value_Output::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Value_Output::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Value_Output::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+VALUEOUTPUT new_fl_value_output(int x, int y, int w, int h, char* label) {
+ My_Value_Output *a = new My_Value_Output(x, y, w, h, label);
+ return a;
+}
+
+void free_fl_value_output(VALUEOUTPUT a) {
+ delete static_cast<My_Value_Output*>(a);
+}
+
+
+
+
+int fl_value_output_is_soft(VALUEOUTPUT a) {
+ return static_cast<Fl_Value_Output*>(a)->soft();
+}
+
+void fl_value_output_set_soft(VALUEOUTPUT a, int t) {
+ static_cast<Fl_Value_Output*>(a)->soft(t);
+}
+
+
+
+
+unsigned int fl_value_output_get_text_color(VALUEOUTPUT v) {
+ return static_cast<Fl_Value_Output*>(v)->textcolor();
+}
+
+void fl_value_output_set_text_color(VALUEOUTPUT v, unsigned int c) {
+ static_cast<Fl_Value_Output*>(v)->textcolor(static_cast<Fl_Color>(c));
+}
+
+int fl_value_output_get_text_font(VALUEOUTPUT v) {
+ return static_cast<Fl_Value_Output*>(v)->textfont();
+}
+
+void fl_value_output_set_text_font(VALUEOUTPUT v, int f) {
+ static_cast<Fl_Value_Output*>(v)->textfont(static_cast<Fl_Font>(f));
+}
+
+int fl_value_output_get_text_size(VALUEOUTPUT v) {
+ return static_cast<Fl_Value_Output*>(v)->textsize();
+}
+
+void fl_value_output_set_text_size(VALUEOUTPUT v, int s) {
+ static_cast<Fl_Value_Output*>(v)->textsize(static_cast<Fl_Fontsize>(s));
+}
+
+
+
+
+void fl_value_output_draw(VALUEOUTPUT a) {
+ static_cast<My_Value_Output*>(a)->Fl_Value_Output::draw();
+}
+
+int fl_value_output_handle(VALUEOUTPUT a, int e) {
+ return static_cast<My_Value_Output*>(a)->Fl_Value_Output::handle(e);
+}
+
+
diff --git a/body/c_fl_value_output.h b/body/c_fl_value_output.h
new file mode 100644
index 0000000..e333ff8
--- /dev/null
+++ b/body/c_fl_value_output.h
@@ -0,0 +1,36 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_VALUE_OUTPUT_GUARD
+#define FL_VALUE_OUTPUT_GUARD
+
+
+typedef void* VALUEOUTPUT;
+
+
+extern "C" VALUEOUTPUT new_fl_value_output(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_value_output(VALUEOUTPUT a);
+
+
+extern "C" int fl_value_output_is_soft(VALUEOUTPUT a);
+extern "C" void fl_value_output_set_soft(VALUEOUTPUT a, int t);
+
+
+extern "C" unsigned int fl_value_output_get_text_color(VALUEOUTPUT v);
+extern "C" void fl_value_output_set_text_color(VALUEOUTPUT v, unsigned int c);
+extern "C" int fl_value_output_get_text_font(VALUEOUTPUT v);
+extern "C" void fl_value_output_set_text_font(VALUEOUTPUT v, int f);
+extern "C" int fl_value_output_get_text_size(VALUEOUTPUT v);
+extern "C" void fl_value_output_set_text_size(VALUEOUTPUT v, int s);
+
+
+extern "C" void fl_value_output_draw(VALUEOUTPUT a);
+extern "C" int fl_value_output_handle(VALUEOUTPUT a, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_value_slider.cpp b/body/c_fl_value_slider.cpp
new file mode 100644
index 0000000..ac7498c
--- /dev/null
+++ b/body/c_fl_value_slider.cpp
@@ -0,0 +1,101 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Value_Slider.H>
+#include "c_fl_value_slider.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" int valuator_format_hook(void * ud, char * buf);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Value_Slider : public Fl_Value_Slider {
+public:
+ using Fl_Value_Slider::Fl_Value_Slider;
+
+ friend void fl_value_slider_draw(VALUESLIDER s);
+ friend int fl_value_slider_handle(VALUESLIDER s, int e);
+
+ int format(char * buf);
+ void draw();
+ int handle(int e);
+};
+
+int My_Value_Slider::format(char * buf) {
+ return valuator_format_hook(this->user_data(), buf);
+}
+
+void My_Value_Slider::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Value_Slider::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+VALUESLIDER new_fl_value_slider(int x, int y, int w, int h, char* label) {
+ My_Value_Slider *s = new My_Value_Slider(x, y, w, h, label);
+ return s;
+}
+
+void free_fl_value_slider(VALUESLIDER s) {
+ delete static_cast<My_Value_Slider*>(s);
+}
+
+
+
+
+unsigned int fl_value_slider_get_textcolor(VALUESLIDER s) {
+ return static_cast<Fl_Value_Slider*>(s)->textcolor();
+}
+
+void fl_value_slider_set_textcolor(VALUESLIDER s, unsigned int t) {
+ static_cast<Fl_Value_Slider*>(s)->textcolor(t);
+}
+
+int fl_value_slider_get_textfont(VALUESLIDER s) {
+ return static_cast<Fl_Value_Slider*>(s)->textfont();
+}
+
+void fl_value_slider_set_textfont(VALUESLIDER s, int t) {
+ static_cast<Fl_Value_Slider*>(s)->textfont(t);
+}
+
+int fl_value_slider_get_textsize(VALUESLIDER s) {
+ return static_cast<Fl_Value_Slider*>(s)->textsize();
+}
+
+void fl_value_slider_set_textsize(VALUESLIDER s, int t) {
+ static_cast<Fl_Value_Slider*>(s)->textsize(t);
+}
+
+
+
+
+void fl_value_slider_draw(VALUESLIDER s) {
+ static_cast<My_Value_Slider*>(s)->Fl_Value_Slider::draw();
+}
+
+int fl_value_slider_handle(VALUESLIDER s, int e) {
+ return static_cast<My_Value_Slider*>(s)->Fl_Value_Slider::handle(e);
+}
+
+
diff --git a/body/c_fl_value_slider.h b/body/c_fl_value_slider.h
new file mode 100644
index 0000000..b07a827
--- /dev/null
+++ b/body/c_fl_value_slider.h
@@ -0,0 +1,32 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_VALUE_SLIDER_GUARD
+#define FL_VALUE_SLIDER_GUARD
+
+
+typedef void* VALUESLIDER;
+
+
+extern "C" VALUESLIDER new_fl_value_slider(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_value_slider(VALUESLIDER s);
+
+
+extern "C" unsigned int fl_value_slider_get_textcolor(VALUESLIDER s);
+extern "C" void fl_value_slider_set_textcolor(VALUESLIDER s, unsigned int t);
+extern "C" int fl_value_slider_get_textfont(VALUESLIDER s);
+extern "C" void fl_value_slider_set_textfont(VALUESLIDER s, int t);
+extern "C" int fl_value_slider_get_textsize(VALUESLIDER s);
+extern "C" void fl_value_slider_set_textsize(VALUESLIDER s, int t);
+
+
+extern "C" void fl_value_slider_draw(VALUESLIDER s);
+extern "C" int fl_value_slider_handle(VALUESLIDER s, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_widget.cpp b/body/c_fl_widget.cpp
new file mode 100644
index 0000000..6eda9e3
--- /dev/null
+++ b/body/c_fl_widget.cpp
@@ -0,0 +1,400 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Widget.H>
+#include <FL/Fl_Image.H>
+#include "c_fl_widget.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Non-friend protected access
+
+class Friend_Widget : Fl_Widget {
+public:
+ // probably expand this later when doing a pass for protected methods
+ using Fl_Widget::draw_box;
+};
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Widget : public Fl_Widget {
+public:
+ using Fl_Widget::Fl_Widget;
+ friend WIDGET new_fl_widget(int x, int y, int w, int h, char* label);
+
+ friend void fl_widget_draw(WIDGET w);
+ friend int fl_widget_handle(WIDGET w, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Widget::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Widget::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+WIDGET new_fl_widget(int x, int y, int w, int h, char* label) {
+ My_Widget *wd = new My_Widget(x, y, w, h, label);
+ return wd;
+}
+
+void free_fl_widget(WIDGET w) {
+ delete static_cast<My_Widget*>(w);
+}
+
+
+
+
+void * fl_widget_get_user_data(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->user_data();
+}
+
+void fl_widget_set_user_data(WIDGET w, void * d) {
+ static_cast<Fl_Widget*>(w)->user_data(d);
+}
+
+
+
+
+void fl_widget_activate(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->activate();
+}
+
+void fl_widget_deactivate(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->deactivate();
+}
+
+int fl_widget_active(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->active();
+}
+
+int fl_widget_active_r(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->active_r();
+}
+
+void fl_widget_set_active(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->set_active();
+}
+
+void fl_widget_clear_active(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->clear_active();
+}
+
+
+
+
+unsigned int fl_widget_changed(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->changed();
+}
+
+void fl_widget_set_changed(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->set_changed();
+}
+
+void fl_widget_clear_changed(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->clear_changed();
+}
+
+int fl_widget_output(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->output();
+}
+
+void fl_widget_set_output(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->set_output();
+}
+
+void fl_widget_clear_output(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->clear_output();
+}
+
+int fl_widget_visible(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->visible();
+}
+
+int fl_widget_visible_r(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->visible_r();
+}
+
+void fl_widget_set_visible(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->set_visible();
+}
+
+void fl_widget_clear_visible(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->clear_visible();
+}
+
+
+
+
+int fl_widget_get_visible_focus(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->visible_focus();
+}
+
+void fl_widget_set_visible_focus(WIDGET w, int f) {
+ static_cast<Fl_Widget*>(w)->visible_focus(f);
+}
+
+int fl_widget_take_focus(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->take_focus();
+}
+
+int fl_widget_takesevents(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->takesevents();
+}
+
+
+
+
+unsigned int fl_widget_get_color(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->color();
+}
+
+void fl_widget_set_color(WIDGET w, unsigned int b) {
+ static_cast<Fl_Widget*>(w)->color(b);
+}
+
+unsigned int fl_widget_get_selection_color(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->selection_color();
+}
+
+void fl_widget_set_selection_color(WIDGET w, unsigned int c) {
+ static_cast<Fl_Widget*>(w)->selection_color(c);
+}
+
+
+
+
+void * fl_widget_get_parent(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->parent();
+}
+
+int fl_widget_contains(WIDGET w, WIDGET i) {
+ return static_cast<Fl_Widget*>(w)->contains(static_cast<Fl_Widget*>(i));
+}
+
+int fl_widget_inside(WIDGET w, WIDGET p) {
+ return static_cast<Fl_Widget*>(w)->inside(static_cast<Fl_Widget*>(p));
+}
+
+void * fl_widget_window(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->window();
+}
+
+void * fl_widget_top_window(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->top_window();
+}
+
+void * fl_widget_top_window_offset(WIDGET w, int &x, int &y) {
+ return static_cast<Fl_Widget*>(w)->top_window_offset(x,y);
+}
+
+
+
+
+unsigned int fl_widget_get_align(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->align();
+}
+
+void fl_widget_set_align(WIDGET w, unsigned int a) {
+ static_cast<Fl_Widget*>(w)->align(a);
+}
+
+int fl_widget_get_box(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->box();
+}
+
+void fl_widget_set_box(WIDGET w, int b) {
+ static_cast<Fl_Widget*>(w)->box(static_cast<Fl_Boxtype>(b));
+}
+
+const char * fl_widget_tooltip(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->tooltip();
+}
+
+void fl_widget_copy_tooltip(WIDGET w, const char * t) {
+ static_cast<Fl_Widget*>(w)->copy_tooltip(t);
+}
+
+
+
+
+const char* fl_widget_get_label(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->label();
+}
+
+void fl_widget_set_label(WIDGET w, const char* t) {
+ static_cast<Fl_Widget*>(w)->copy_label(t);
+}
+
+unsigned int fl_widget_get_labelcolor(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->labelcolor();
+}
+
+void fl_widget_set_labelcolor(WIDGET w, unsigned int v) {
+ static_cast<Fl_Widget*>(w)->labelcolor(v);
+}
+
+int fl_widget_get_labelfont(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->labelfont();
+}
+
+void fl_widget_set_labelfont(WIDGET w, int f) {
+ static_cast<Fl_Widget*>(w)->labelfont(static_cast<Fl_Font>(f));
+}
+
+int fl_widget_get_labelsize(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->labelsize();
+}
+
+void fl_widget_set_labelsize(WIDGET w, int s) {
+ static_cast<Fl_Widget*>(w)->labelsize(static_cast<Fl_Fontsize>(s));
+}
+
+int fl_widget_get_labeltype(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->labeltype();
+}
+
+void fl_widget_set_labeltype(WIDGET w, int l) {
+ static_cast<Fl_Widget*>(w)->labeltype(static_cast<Fl_Labeltype>(l));
+}
+
+void fl_widget_measure_label(WIDGET w, int &d, int &h) {
+ static_cast<Fl_Widget*>(w)->measure_label(d,h);
+}
+
+
+
+
+void fl_widget_set_callback(WIDGET w, void * cb) {
+ static_cast<Fl_Widget*>(w)->callback(reinterpret_cast<Fl_Callback_p>(cb));
+}
+
+unsigned int fl_widget_get_when(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->when();
+}
+
+void fl_widget_set_when(WIDGET w, unsigned int c) {
+ static_cast<Fl_Widget*>(w)->when(c);
+}
+
+
+
+
+int fl_widget_get_x(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->x();
+}
+
+int fl_widget_get_y(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->y();
+}
+
+int fl_widget_get_w(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->w();
+}
+
+int fl_widget_get_h(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->h();
+}
+
+void fl_widget_size(WIDGET w, int d, int h) {
+ static_cast<Fl_Widget*>(w)->size(d, h);
+}
+
+void fl_widget_position(WIDGET w, int x, int y) {
+ static_cast<Fl_Widget*>(w)->position(x, y);
+}
+
+
+
+
+void fl_widget_set_image(WIDGET w, void * img) {
+ static_cast<Fl_Widget*>(w)->image(static_cast<Fl_Image*>(img));
+}
+
+void fl_widget_set_deimage(WIDGET w, void * img) {
+ static_cast<Fl_Widget*>(w)->deimage(static_cast<Fl_Image*>(img));
+}
+
+
+
+
+unsigned char fl_widget_get_type(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->type();
+}
+
+void fl_widget_set_type(WIDGET w, unsigned char t) {
+ static_cast<Fl_Widget*>(w)->type(t);
+}
+
+
+
+
+int fl_widget_damage(WIDGET w) {
+ return static_cast<Fl_Widget*>(w)->damage();
+}
+
+void fl_widget_set_damage(WIDGET w, int t) {
+ if (t != 0) {
+ static_cast<Fl_Widget*>(w)->damage(0xff);
+ } else {
+ static_cast<Fl_Widget*>(w)->damage(0x00);
+ }
+}
+
+void fl_widget_set_damage2(WIDGET w, int t, int x, int y, int d, int h) {
+ if (t != 0) {
+ static_cast<Fl_Widget*>(w)->damage(0xff,x,y,d,h);
+ } else {
+ static_cast<Fl_Widget*>(w)->damage(0x00,x,y,d,h);
+ }
+}
+
+void fl_widget_draw(WIDGET w) {
+ // The Fl_Widget draw method doesn't technically exist, so...
+ (void)(w);
+ // It is more convenient for this function to exist, however,
+ // even though it will likely never be called, because it simplifies
+ // and makes uniform the implementation of the Ada Widget Draw subprogram.
+}
+
+void fl_widget_draw_label(WIDGET w, int x, int y, int d, int h, unsigned int a) {
+ static_cast<Fl_Widget*>(w)->draw_label(x,y,d,h,a);
+}
+
+void fl_widget_redraw(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->redraw();
+}
+
+void fl_widget_redraw_label(WIDGET w) {
+ static_cast<Fl_Widget*>(w)->redraw_label();
+}
+
+int fl_widget_handle(WIDGET w, int e) {
+ return static_cast<My_Widget*>(w)->Fl_Widget::handle(e);
+}
+
+
diff --git a/body/c_fl_widget.h b/body/c_fl_widget.h
new file mode 100644
index 0000000..9634ba4
--- /dev/null
+++ b/body/c_fl_widget.h
@@ -0,0 +1,116 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_WIDGET_GUARD
+#define FL_WIDGET_GUARD
+
+
+typedef void* WIDGET;
+
+
+extern "C" WIDGET new_fl_widget(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_widget(WIDGET w);
+
+
+extern "C" void * fl_widget_get_user_data(WIDGET w);
+extern "C" void fl_widget_set_user_data(WIDGET w, void * d);
+
+
+extern "C" void fl_widget_activate(WIDGET w);
+extern "C" void fl_widget_deactivate(WIDGET w);
+extern "C" int fl_widget_active(WIDGET w);
+extern "C" int fl_widget_active_r(WIDGET w);
+extern "C" void fl_widget_set_active(WIDGET w);
+extern "C" void fl_widget_clear_active(WIDGET w);
+
+
+extern "C" unsigned int fl_widget_changed(WIDGET w);
+extern "C" void fl_widget_set_changed(WIDGET w);
+extern "C" void fl_widget_clear_changed(WIDGET w);
+extern "C" int fl_widget_output(WIDGET w);
+extern "C" void fl_widget_set_output(WIDGET w);
+extern "C" void fl_widget_clear_output(WIDGET w);
+extern "C" int fl_widget_visible(WIDGET w);
+extern "C" int fl_widget_visible_r(WIDGET w);
+extern "C" void fl_widget_set_visible(WIDGET w);
+extern "C" void fl_widget_clear_visible(WIDGET w);
+
+
+extern "C" int fl_widget_get_visible_focus(WIDGET w);
+extern "C" void fl_widget_set_visible_focus(WIDGET w, int f);
+extern "C" int fl_widget_take_focus(WIDGET w);
+extern "C" int fl_widget_takesevents(WIDGET w);
+
+
+extern "C" unsigned int fl_widget_get_color(WIDGET w);
+extern "C" void fl_widget_set_color(WIDGET w, unsigned int b);
+extern "C" unsigned int fl_widget_get_selection_color(WIDGET w);
+extern "C" void fl_widget_set_selection_color(WIDGET w, unsigned int c);
+
+
+extern "C" void * fl_widget_get_parent(WIDGET w);
+extern "C" int fl_widget_contains(WIDGET w, WIDGET i);
+extern "C" int fl_widget_inside(WIDGET w, WIDGET p);
+extern "C" void * fl_widget_window(WIDGET w);
+extern "C" void * fl_widget_top_window(WIDGET w);
+extern "C" void * fl_widget_top_window_offset(WIDGET w, int &x, int &y);
+
+
+extern "C" unsigned int fl_widget_get_align(WIDGET w);
+extern "C" void fl_widget_set_align(WIDGET w, unsigned int a);
+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_tooltip(WIDGET w);
+extern "C" void fl_widget_copy_tooltip(WIDGET w, const char * t);
+
+
+extern "C" const char* fl_widget_get_label(WIDGET w);
+extern "C" void fl_widget_set_label(WIDGET w, const char* t);
+extern "C" unsigned int fl_widget_get_labelcolor(WIDGET w);
+extern "C" void fl_widget_set_labelcolor(WIDGET w, unsigned int v);
+extern "C" int fl_widget_get_labelfont(WIDGET w);
+extern "C" void fl_widget_set_labelfont(WIDGET w, int f);
+extern "C" int fl_widget_get_labelsize(WIDGET w);
+extern "C" void fl_widget_set_labelsize(WIDGET w, int s);
+extern "C" int fl_widget_get_labeltype(WIDGET w);
+extern "C" void fl_widget_set_labeltype(WIDGET w, int l);
+extern "C" void fl_widget_measure_label(WIDGET w, int &d, int &h);
+
+
+extern "C" void fl_widget_set_callback(WIDGET w, void * cb);
+extern "C" unsigned int fl_widget_get_when(WIDGET w);
+extern "C" void fl_widget_set_when(WIDGET w, unsigned int c);
+
+
+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);
+extern "C" void fl_widget_set_deimage(WIDGET w, void * img);
+
+
+extern "C" unsigned char fl_widget_get_type(WIDGET w);
+extern "C" void fl_widget_set_type(WIDGET w, unsigned char t);
+
+
+extern "C" int fl_widget_damage(WIDGET w);
+extern "C" void fl_widget_set_damage(WIDGET w, int t);
+extern "C" void fl_widget_set_damage2(WIDGET w, int t, int x, int y, int d, int h);
+extern "C" void fl_widget_draw(WIDGET w);
+extern "C" void fl_widget_draw_label(WIDGET w, int x, int y, int d, int h, unsigned int a);
+extern "C" void fl_widget_redraw(WIDGET w);
+extern "C" void fl_widget_redraw_label(WIDGET w);
+extern "C" int fl_widget_handle(WIDGET w, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_window.cpp b/body/c_fl_window.cpp
new file mode 100644
index 0000000..806e66f
--- /dev/null
+++ b/body/c_fl_window.cpp
@@ -0,0 +1,249 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Window.H>
+#include <FL/Fl_RGB_Image.H>
+#include "c_fl_window.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Window : public Fl_Window {
+public:
+ using Fl_Window::Fl_Window;
+
+ friend void fl_window_draw(WINDOW n);
+ friend int fl_window_handle(WINDOW n, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Window::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Window::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+WINDOW new_fl_window(int x, int y, int w, int h, char* label) {
+ My_Window *n = new My_Window(x, y, w, h, label);
+ return n;
+}
+
+WINDOW new_fl_window2(int w, int h, char* label) {
+ My_Window *n = new My_Window(w, h, label);
+ return n;
+}
+
+void free_fl_window(WINDOW n) {
+ delete static_cast<My_Window*>(n);
+}
+
+
+
+
+void fl_window_show(WINDOW n) {
+ // virtual, so disable dispatch
+ static_cast<Fl_Window*>(n)->Fl_Window::show();
+}
+
+void fl_window_show2(WINDOW n, int c, void * v) {
+ static_cast<Fl_Window*>(n)->show(c, static_cast<char**>(v));
+}
+
+void fl_window_hide(WINDOW n) {
+ // virtual, so disable dispatch
+ static_cast<Fl_Window*>(n)->Fl_Window::hide();
+}
+
+int fl_window_shown(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->shown();
+}
+
+void fl_window_wait_for_expose(WINDOW n) {
+ static_cast<Fl_Window*>(n)->wait_for_expose();
+}
+
+void fl_window_iconize(WINDOW n) {
+ static_cast<Fl_Window*>(n)->iconize();
+}
+
+void fl_window_make_current(WINDOW n) {
+ static_cast<Fl_Window*>(n)->make_current();
+}
+
+void fl_window_free_position(WINDOW n) {
+ static_cast<Fl_Window*>(n)->free_position();
+}
+
+
+
+
+unsigned int fl_window_fullscreen_active(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->fullscreen_active();
+}
+
+void fl_window_fullscreen(WINDOW n) {
+ static_cast<Fl_Window*>(n)->fullscreen();
+}
+
+void fl_window_fullscreen_off(WINDOW n) {
+ static_cast<Fl_Window*>(n)->fullscreen_off();
+}
+
+void fl_window_fullscreen_off2(WINDOW n, int x, int y, int w, int h) {
+ static_cast<Fl_Window*>(n)->fullscreen_off(x,y,w,h);
+}
+
+void fl_window_fullscreen_screens(WINDOW n, int t, int b, int l, int r) {
+ static_cast<Fl_Window*>(n)->fullscreen_screens(t,b,l,r);
+}
+
+
+
+
+void fl_window_set_icon(WINDOW n, void * img) {
+ static_cast<Fl_Window*>(n)->icon(static_cast<Fl_RGB_Image*>(img));
+}
+
+void fl_window_default_icon(void * img) {
+ Fl_Window::default_icon(static_cast<Fl_RGB_Image*>(img));
+}
+
+const char * fl_window_get_iconlabel(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->iconlabel();
+}
+
+void fl_window_set_iconlabel(WINDOW n, const char * s) {
+ static_cast<Fl_Window*>(n)->iconlabel(s);
+}
+
+void fl_window_set_cursor(WINDOW n, int c) {
+ static_cast<Fl_Window*>(n)->cursor(static_cast<Fl_Cursor>(c));
+}
+
+void fl_window_set_cursor2(WINDOW n, void * img, int x, int y) {
+ static_cast<Fl_Window*>(n)->cursor(static_cast<Fl_RGB_Image*>(img),x,y);
+}
+
+void fl_window_set_default_cursor(WINDOW n, int c) {
+ static_cast<Fl_Window*>(n)->default_cursor(static_cast<Fl_Cursor>(c));
+}
+
+
+
+
+unsigned int fl_window_get_border(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->border();
+}
+
+void fl_window_set_border(WINDOW n, int b) {
+ static_cast<Fl_Window*>(n)->border(b);
+}
+
+unsigned int fl_window_get_override(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->override();
+}
+
+void fl_window_set_override(WINDOW n) {
+ static_cast<Fl_Window*>(n)->set_override();
+}
+
+unsigned int fl_window_modal(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->modal();
+}
+
+unsigned int fl_window_non_modal(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->non_modal();
+}
+
+void fl_window_clear_modal_states(WINDOW n) {
+ static_cast<Fl_Window*>(n)->clear_modal_states();
+}
+
+void fl_window_set_modal(WINDOW n) {
+ static_cast<Fl_Window*>(n)->set_modal();
+}
+
+void fl_window_set_non_modal(WINDOW n) {
+ static_cast<Fl_Window*>(n)->set_non_modal();
+}
+
+
+
+
+const char * fl_window_get_label(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->label();
+}
+
+void fl_window_set_label(WINDOW n, char* text) {
+ static_cast<Fl_Window*>(n)->copy_label(text);
+}
+
+void fl_window_hotspot(WINDOW n, int x, int y, int s) {
+ static_cast<Fl_Window*>(n)->hotspot(x,y,s);
+}
+
+void fl_window_hotspot2(WINDOW n, void * i, int s) {
+ static_cast<Fl_Window*>(n)->hotspot(static_cast<Fl_Widget*>(i),s);
+}
+
+void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a) {
+ static_cast<Fl_Window*>(n)->size_range(lw, lh, hw, hh, dw, dh, a);
+}
+
+void fl_window_shape(WINDOW n, void * p) {
+ static_cast<Fl_Window*>(n)->shape(static_cast<Fl_Image*>(p));
+}
+
+
+
+
+int fl_window_get_x_root(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->x_root();
+}
+
+int fl_window_get_y_root(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->y_root();
+}
+
+int fl_window_get_decorated_w(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->decorated_w();
+}
+
+int fl_window_get_decorated_h(WINDOW n) {
+ return static_cast<Fl_Window*>(n)->decorated_h();
+}
+
+
+
+
+void fl_window_draw(WINDOW n) {
+ static_cast<My_Window*>(n)->Fl_Window::draw();
+}
+
+int fl_window_handle(WINDOW n, int e) {
+ return static_cast<My_Window*>(n)->Fl_Window::handle(e);
+}
+
+
diff --git a/body/c_fl_window.h b/body/c_fl_window.h
new file mode 100644
index 0000000..ed6ebdd
--- /dev/null
+++ b/body/c_fl_window.h
@@ -0,0 +1,76 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#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, char* label);
+extern "C" void free_fl_window(WINDOW n);
+
+
+extern "C" void fl_window_show(WINDOW n);
+extern "C" void fl_window_show2(WINDOW n, int c, void * v);
+extern "C" void fl_window_hide(WINDOW n);
+extern "C" int fl_window_shown(WINDOW n);
+extern "C" void fl_window_wait_for_expose(WINDOW n);
+extern "C" void fl_window_iconize(WINDOW n);
+extern "C" void fl_window_make_current(WINDOW n);
+extern "C" void fl_window_free_position(WINDOW n);
+
+
+extern "C" unsigned int fl_window_fullscreen_active(WINDOW n);
+extern "C" void fl_window_fullscreen(WINDOW n);
+extern "C" void fl_window_fullscreen_off(WINDOW n);
+extern "C" void fl_window_fullscreen_off2(WINDOW n, int x, int y, int w, int h);
+extern "C" void fl_window_fullscreen_screens(WINDOW n, int t, int b, int l, int r);
+
+
+extern "C" void fl_window_set_icon(WINDOW n, void * img);
+extern "C" void fl_window_default_icon(void * img);
+extern "C" const char * fl_window_get_iconlabel(WINDOW n);
+extern "C" void fl_window_set_iconlabel(WINDOW n, const char * s);
+extern "C" void fl_window_set_cursor(WINDOW n, int c);
+extern "C" void fl_window_set_cursor2(WINDOW n, void * img, int x, int y);
+extern "C" void fl_window_set_default_cursor(WINDOW n, int c);
+
+
+extern "C" unsigned int fl_window_get_border(WINDOW n);
+extern "C" void fl_window_set_border(WINDOW n, int b);
+extern "C" unsigned int fl_window_get_override(WINDOW n);
+extern "C" void fl_window_set_override(WINDOW n);
+extern "C" unsigned int fl_window_modal(WINDOW n);
+extern "C" unsigned int fl_window_non_modal(WINDOW n);
+extern "C" void fl_window_clear_modal_states(WINDOW n);
+extern "C" void fl_window_set_modal(WINDOW n);
+extern "C" void fl_window_set_non_modal(WINDOW n);
+
+
+extern "C" const char * fl_window_get_label(WINDOW n);
+extern "C" void fl_window_set_label(WINDOW n, char* text);
+extern "C" void fl_window_hotspot(WINDOW n, int x, int y, int s);
+extern "C" void fl_window_hotspot2(WINDOW n, void * i, int s);
+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_shape(WINDOW n, void * p);
+
+
+extern "C" int fl_window_get_x_root(WINDOW n);
+extern "C" int fl_window_get_y_root(WINDOW n);
+extern "C" int fl_window_get_decorated_w(WINDOW n);
+extern "C" int fl_window_get_decorated_h(WINDOW n);
+
+
+extern "C" void fl_window_draw(WINDOW n);
+extern "C" int fl_window_handle(WINDOW n, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_wizard.cpp b/body/c_fl_wizard.cpp
new file mode 100644
index 0000000..e29995a
--- /dev/null
+++ b/body/c_fl_wizard.cpp
@@ -0,0 +1,106 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Wizard.H>
+#include "c_fl_wizard.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Wizard : public Fl_Wizard {
+public:
+ using Fl_Wizard::Fl_Wizard;
+
+ friend void fl_wizard_draw(WIZARD w);
+ friend int fl_wizard_handle(WIZARD w, int e);
+
+ void draw();
+ void real_draw();
+ int handle(int e);
+};
+
+void My_Wizard::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+void My_Wizard::real_draw() {
+ // required because of Fl_Wizard::draw() being private
+ // probably a bug in FLTK?
+ Fl_Widget *kid = value();
+ if (damage() & FL_DAMAGE_ALL) {
+ if (kid) {
+ draw_box(box(), x(), y(), w(), h(), kid->color());
+ draw_child(*kid);
+ } else {
+ draw_box(box(), x(), y(), w(), h(), color());
+ }
+ } else if (kid) {
+ update_child(*kid);
+ }
+}
+
+int My_Wizard::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+WIZARD new_fl_wizard(int x, int y, int w, int h, char* label) {
+ My_Wizard *g = new My_Wizard(x, y, w, h, label);
+ return g;
+}
+
+void free_fl_wizard(WIZARD w) {
+ delete static_cast<My_Wizard*>(w);
+}
+
+
+
+
+void fl_wizard_next(WIZARD w) {
+ static_cast<Fl_Wizard*>(w)->next();
+}
+
+void fl_wizard_prev(WIZARD w) {
+ static_cast<Fl_Wizard*>(w)->prev();
+}
+
+
+
+
+void * fl_wizard_get_visible(WIZARD w) {
+ return static_cast<Fl_Wizard*>(w)->value();
+}
+
+void fl_wizard_set_visible(WIZARD w, void * i) {
+ static_cast<Fl_Wizard*>(w)->value(static_cast<Fl_Widget*>(i));
+}
+
+
+
+
+void fl_wizard_draw(WIZARD w) {
+ static_cast<My_Wizard*>(w)->real_draw();
+}
+
+int fl_wizard_handle(WIZARD w, int e) {
+ return static_cast<My_Wizard*>(w)->Fl_Wizard::handle(e);
+}
+
+
diff --git a/body/c_fl_wizard.h b/body/c_fl_wizard.h
new file mode 100644
index 0000000..fb710ec
--- /dev/null
+++ b/body/c_fl_wizard.h
@@ -0,0 +1,32 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_WIZARD_GUARD
+#define FL_WIZARD_GUARD
+
+
+typedef void* WIZARD;
+
+
+extern "C" WIZARD new_fl_wizard(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_wizard(WIZARD w);
+
+
+extern "C" void fl_wizard_next(WIZARD w);
+extern "C" void fl_wizard_prev(WIZARD w);
+
+
+extern "C" void * fl_wizard_get_visible(WIZARD w);
+extern "C" void fl_wizard_set_visible(WIZARD w, void * i);
+
+
+extern "C" void fl_wizard_draw(WIZARD w);
+extern "C" int fl_wizard_handle(WIZARD w, int e);
+
+
+#endif
+
+
diff --git a/body/c_fl_xbm_image.cpp b/body/c_fl_xbm_image.cpp
new file mode 100644
index 0000000..2ecd890
--- /dev/null
+++ b/body/c_fl_xbm_image.cpp
@@ -0,0 +1,22 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_XBM_Image.H>
+#include "c_fl_xbm_image.h"
+
+
+
+
+XBMIMAGE new_fl_xbm_image(const char * f) {
+ Fl_XBM_Image *b = new Fl_XBM_Image(f);
+ return b;
+}
+
+void free_fl_xbm_image(XBMIMAGE b) {
+ delete static_cast<Fl_XBM_Image*>(b);
+}
+
+
diff --git a/body/c_fl_xbm_image.h b/body/c_fl_xbm_image.h
new file mode 100644
index 0000000..668d3f8
--- /dev/null
+++ b/body/c_fl_xbm_image.h
@@ -0,0 +1,20 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_XBM_IMAGE_GUARD
+#define FL_XBM_IMAGE_GUARD
+
+
+typedef void* XBMIMAGE;
+
+
+extern "C" XBMIMAGE new_fl_xbm_image(const char * f);
+extern "C" void free_fl_xbm_image(XBMIMAGE b);
+
+
+#endif
+
+
diff --git a/body/c_fl_xpm_image.cpp b/body/c_fl_xpm_image.cpp
new file mode 100644
index 0000000..fcf60c2
--- /dev/null
+++ b/body/c_fl_xpm_image.cpp
@@ -0,0 +1,22 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_XPM_Image.H>
+#include "c_fl_xpm_image.h"
+
+
+
+
+XPMIMAGE new_fl_xpm_image(const char * f) {
+ Fl_XPM_Image *j = new Fl_XPM_Image(f);
+ return j;
+}
+
+void free_fl_xpm_image(XPMIMAGE j) {
+ delete static_cast<Fl_XPM_Image*>(j);
+}
+
+
diff --git a/body/c_fl_xpm_image.h b/body/c_fl_xpm_image.h
new file mode 100644
index 0000000..a925c33
--- /dev/null
+++ b/body/c_fl_xpm_image.h
@@ -0,0 +1,20 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_XPM_IMAGE_GUARD
+#define FL_XPM_IMAGE_GUARD
+
+
+typedef void* XPMIMAGE;
+
+
+extern "C" XPMIMAGE new_fl_xpm_image(const char * f);
+extern "C" void free_fl_xpm_image(XPMIMAGE j);
+
+
+#endif
+
+
diff --git a/body/fltk-asks.adb b/body/fltk-asks.adb
new file mode 100644
index 0000000..bd09fac
--- /dev/null
+++ b/body/fltk-asks.adb
@@ -0,0 +1,659 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Asks is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function fl_ask_get_cancel
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_ask_get_cancel, "fl_ask_get_cancel");
+ pragma Inline (fl_ask_get_cancel);
+
+ procedure fl_ask_set_cancel
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_ask_set_cancel, "fl_ask_set_cancel");
+ pragma Inline (fl_ask_set_cancel);
+
+ function fl_ask_get_close
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_ask_get_close, "fl_ask_get_close");
+ pragma Inline (fl_ask_get_close);
+
+ procedure fl_ask_set_close
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_ask_set_close, "fl_ask_set_close");
+ pragma Inline (fl_ask_set_close);
+
+ function fl_ask_get_no
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_ask_get_no, "fl_ask_get_no");
+ pragma Inline (fl_ask_get_no);
+
+ procedure fl_ask_set_no
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_ask_set_no, "fl_ask_set_no");
+ pragma Inline (fl_ask_set_no);
+
+ function fl_ask_get_ok
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_ask_get_ok, "fl_ask_get_ok");
+ pragma Inline (fl_ask_get_ok);
+
+ procedure fl_ask_set_ok
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_ask_set_ok, "fl_ask_set_ok");
+ pragma Inline (fl_ask_set_ok);
+
+ function fl_ask_get_yes
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_ask_get_yes, "fl_ask_get_yes");
+ pragma Inline (fl_ask_get_yes);
+
+ procedure fl_ask_set_yes
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_ask_set_yes, "fl_ask_set_yes");
+ pragma Inline (fl_ask_set_yes);
+
+
+
+
+ procedure fl_ask_alert
+ (M : in Interfaces.C.char_array);
+ pragma Import (C, fl_ask_alert, "fl_ask_alert");
+ pragma Inline (fl_ask_alert);
+
+ procedure fl_ask_beep
+ (B : in Interfaces.C.int);
+ pragma Import (C, fl_ask_beep, "fl_ask_beep");
+ pragma Inline (fl_ask_beep);
+
+ function fl_ask_choice
+ (M, A : in Interfaces.C.char_array;
+ B, C : in Interfaces.C.Strings.chars_ptr)
+ return Interfaces.C.int;
+ pragma Import (C, fl_ask_choice, "fl_ask_choice");
+ pragma Inline (fl_ask_choice);
+
+ function fl_ask_choice_n
+ (M, A : in Interfaces.C.char_array;
+ B, C : in Interfaces.C.Strings.chars_ptr)
+ return Interfaces.C.int;
+ pragma Import (C, fl_ask_choice_n, "fl_ask_choice_n");
+ pragma Inline (fl_ask_choice_n);
+
+ function fl_ask_input
+ (M, D : in Interfaces.C.char_array)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_ask_input, "fl_ask_input");
+ pragma Inline (fl_ask_input);
+
+ procedure fl_ask_message
+ (M : in Interfaces.C.char_array);
+ pragma Import (C, fl_ask_message, "fl_ask_message");
+ pragma Inline (fl_ask_message);
+
+ function fl_ask_password
+ (M, D : in Interfaces.C.char_array)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_ask_password, "fl_ask_password");
+ pragma Inline (fl_ask_password);
+
+
+
+
+ function fl_ask_color_chooser
+ (N : in Interfaces.C.char_array;
+ R, G, B : in out Interfaces.C.double;
+ M : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_ask_color_chooser, "fl_ask_color_chooser");
+ pragma Inline (fl_ask_color_chooser);
+
+ function fl_ask_color_chooser2
+ (N : in Interfaces.C.char_array;
+ R, G, B : in out Interfaces.C.unsigned_char;
+ M : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_ask_color_chooser2, "fl_ask_color_chooser2");
+ pragma Inline (fl_ask_color_chooser2);
+
+ function fl_ask_dir_chooser
+ (M, D : in Interfaces.C.char_array;
+ R : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_ask_dir_chooser, "fl_ask_dir_chooser");
+ pragma Inline (fl_ask_dir_chooser);
+
+ function fl_ask_file_chooser
+ (M, P, D : in Interfaces.C.char_array;
+ R : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_ask_file_chooser, "fl_ask_file_chooser");
+ pragma Inline (fl_ask_file_chooser);
+
+ procedure fl_ask_file_chooser_callback
+ (CB : in Storage.Integer_Address);
+ pragma Import (C, fl_ask_file_chooser_callback, "fl_ask_file_chooser_callback");
+ pragma Inline (fl_ask_file_chooser_callback);
+
+ procedure fl_ask_file_chooser_ok_label
+ (L : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_ask_file_chooser_ok_label, "fl_ask_file_chooser_ok_label");
+ pragma Inline (fl_ask_file_chooser_ok_label);
+
+
+
+
+ function fl_ask_get_message_hotspot
+ return Interfaces.C.int;
+ pragma Import (C, fl_ask_get_message_hotspot, "fl_ask_get_message_hotspot");
+ pragma Inline (fl_ask_get_message_hotspot);
+
+ procedure fl_ask_set_message_hotspot
+ (V : in Interfaces.C.int);
+ pragma Import (C, fl_ask_set_message_hotspot, "fl_ask_set_message_hotspot");
+ pragma Inline (fl_ask_set_message_hotspot);
+
+ procedure fl_ask_message_font
+ (F, S : in Interfaces.C.int);
+ pragma Import (C, fl_ask_message_font, "fl_ask_message_font");
+ pragma Inline (fl_ask_message_font);
+
+ function fl_ask_message_icon
+ return Storage.Integer_Address;
+ pragma Import (C, fl_ask_message_icon, "fl_ask_message_icon");
+ pragma Inline (fl_ask_message_icon);
+
+ procedure fl_ask_message_title
+ (T : in Interfaces.C.char_array);
+ pragma Import (C, fl_ask_message_title, "fl_ask_message_title");
+ pragma Inline (fl_ask_message_title);
+
+ procedure fl_ask_message_title_default
+ (T : in Interfaces.C.char_array);
+ pragma Import (C, fl_ask_message_title_default, "fl_ask_message_title_default");
+ pragma Inline (fl_ask_message_title_default);
+
+
+
+
+ ---------------------
+ -- Callback Hook --
+ ---------------------
+
+ procedure File_Chooser_Callback_Hook
+ (C_Str : in Interfaces.C.Strings.chars_ptr);
+
+ pragma Convention (C, File_Chooser_Callback_Hook);
+
+ procedure File_Chooser_Callback_Hook
+ (C_Str : in Interfaces.C.Strings.chars_ptr) is
+ begin
+ if Chooser_Func /= null then
+ Chooser_Func (Interfaces.C.Strings.Value (C_Str));
+ end if;
+ end File_Chooser_Callback_Hook;
+
+
+
+
+ ---------------
+ -- Cleanup --
+ ---------------
+
+ procedure Finalize
+ (This : in out Dialog_String_Final_Controller)
+ is
+ use Interfaces.C.Strings;
+ begin
+ Free (Cancel_Str);
+ Free (Close_Str);
+ Free (No_Str);
+ Free (OK_Str);
+ Free (Yes_Str);
+ Free (Chooser_OK_Str);
+ end Finalize;
+
+
+
+
+ ------------------
+ -- Attributes --
+ ------------------
+
+ function Get_Cancel_String
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_ask_get_cancel);
+ end Get_Cancel_String;
+
+
+ procedure Set_Cancel_String
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Cancel_Str);
+ Cancel_Str := Interfaces.C.Strings.New_String (Value);
+ fl_ask_set_cancel (Cancel_Str);
+ end Set_Cancel_String;
+
+
+ function Get_Close_String
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_ask_get_close);
+ end Get_Close_String;
+
+
+ procedure Set_Close_String
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Close_Str);
+ Close_Str := Interfaces.C.Strings.New_String (Value);
+ fl_ask_set_close (Close_Str);
+ end Set_Close_String;
+
+
+ function Get_No_String
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_ask_get_no);
+ end Get_No_String;
+
+
+ procedure Set_No_String
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (No_Str);
+ No_Str := Interfaces.C.Strings.New_String (Value);
+ fl_ask_set_no (No_Str);
+ end Set_No_String;
+
+
+ function Get_OK_String
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_ask_get_ok);
+ end Get_OK_String;
+
+
+ procedure Set_OK_String
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (OK_Str);
+ OK_Str := Interfaces.C.Strings.New_String (Value);
+ fl_ask_set_ok (OK_Str);
+ end Set_OK_String;
+
+
+ function Get_Yes_String
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_ask_get_yes);
+ end Get_Yes_String;
+
+
+ procedure Set_Yes_String
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Yes_Str);
+ Yes_Str := Interfaces.C.Strings.New_String (Value);
+ fl_ask_set_yes (Yes_Str);
+ end Set_Yes_String;
+
+
+
+
+ ----------------------
+ -- Common Dialogs --
+ ----------------------
+
+ procedure Alert
+ (Message : String) is
+ begin
+ fl_ask_alert (Interfaces.C.To_C (Message));
+ end Alert;
+
+
+ procedure Beep
+ (Kind : in Beep_Kind := Default_Beep) is
+ begin
+ fl_ask_beep (Beep_Kind'Pos (Kind));
+ end Beep;
+
+
+ function Choice
+ (Message, Button1 : in String)
+ return Choice_Result
+ is
+ Result : Interfaces.C.int := fl_ask_choice
+ (Interfaces.C.To_C (Message),
+ Interfaces.C.To_C (Button1),
+ Interfaces.C.Strings.Null_Ptr,
+ Interfaces.C.Strings.Null_Ptr);
+ begin
+ return Choice_Result'Val (Result);
+ end Choice;
+
+
+ function Choice
+ (Message, Button1, Button2 : in String)
+ return Choice_Result
+ is
+ Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2);
+ Result : Interfaces.C.int := fl_ask_choice
+ (Interfaces.C.To_C (Message),
+ Interfaces.C.To_C (Button1),
+ Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access),
+ Interfaces.C.Strings.Null_Ptr);
+ begin
+ return Choice_Result'Val (Result);
+ end Choice;
+
+
+ function Choice
+ (Message, Button1, Button2, Button3 : in String)
+ return Choice_Result
+ is
+ Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2);
+ Str3 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button3);
+ Result : Interfaces.C.int := fl_ask_choice
+ (Interfaces.C.To_C (Message),
+ Interfaces.C.To_C (Button1),
+ Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access),
+ Interfaces.C.Strings.To_Chars_Ptr (Str3'Unchecked_Access));
+ begin
+ return Choice_Result'Val (Result);
+ end Choice;
+
+
+ function Extended_Choice
+ (Message, Button1 : in String)
+ return Extended_Choice_Result
+ is
+ Result : Interfaces.C.int := fl_ask_choice_n
+ (Interfaces.C.To_C (Message),
+ Interfaces.C.To_C (Button1),
+ Interfaces.C.Strings.Null_Ptr,
+ Interfaces.C.Strings.Null_Ptr);
+ begin
+ pragma Assert (Result in -3 .. 2);
+ return Extended_Choice_Result'Val (Result mod 6);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Extended_Choice;
+
+
+ function Extended_Choice
+ (Message, Button1, Button2 : in String)
+ return Extended_Choice_Result
+ is
+ Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2);
+ Result : Interfaces.C.int := fl_ask_choice_n
+ (Interfaces.C.To_C (Message),
+ Interfaces.C.To_C (Button1),
+ Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access),
+ Interfaces.C.Strings.Null_Ptr);
+ begin
+ pragma Assert (Result in -3 .. 2);
+ return Extended_Choice_Result'Val (Result mod 6);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Extended_Choice;
+
+
+ function Extended_Choice
+ (Message, Button1, Button2, Button3 : in String)
+ return Extended_Choice_Result
+ is
+ Str2 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button2);
+ Str3 : aliased Interfaces.C.char_array := Interfaces.C.To_C (Button3);
+ Result : Interfaces.C.int := fl_ask_choice_n
+ (Interfaces.C.To_C (Message),
+ Interfaces.C.To_C (Button1),
+ Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access),
+ Interfaces.C.Strings.To_Chars_Ptr (Str3'Unchecked_Access));
+ begin
+ pragma Assert (Result in -3 .. 2);
+ return Extended_Choice_Result'Val (Result mod 6);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Extended_Choice;
+
+
+ function Text_Input
+ (Message : in String;
+ Default : in String := "")
+ return String
+ is
+ Result : Interfaces.C.Strings.chars_ptr := fl_ask_input
+ (Interfaces.C.To_C (Message),
+ Interfaces.C.To_C (Default));
+ begin
+ -- Result does not need dealloc
+ 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
+ fl_ask_message (Interfaces.C.To_C (Message));
+ end Message_Box;
+
+
+ function Password
+ (Message : in String;
+ Default : in String := "")
+ return String
+ is
+ Result : Interfaces.C.Strings.chars_ptr := fl_ask_password
+ (Interfaces.C.To_C (Message),
+ Interfaces.C.To_C (Default));
+ begin
+ -- Result does not need dealloc
+ if Result = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Result);
+ end if;
+ end Password;
+
+
+
+
+ function Color_Chooser
+ (Title : in String;
+ R, G, B : in out RGB_Float;
+ Mode : in FLTK.Widgets.Groups.Color_Choosers.Color_Mode :=
+ FLTK.Widgets.Groups.Color_Choosers.RGB)
+ return Confirm_Result
+ is
+ C_R : Interfaces.C.double := Interfaces.C.double (R);
+ C_G : Interfaces.C.double := Interfaces.C.double (G);
+ C_B : Interfaces.C.double := Interfaces.C.double (B);
+ M : Interfaces.C.int := FLTK.Widgets.Groups.Color_Choosers.Color_Mode'Pos (Mode);
+ Result : Interfaces.C.int := fl_ask_color_chooser
+ (Interfaces.C.To_C (Title), C_R, C_G, C_B, M);
+ begin
+ if Result = 1 then
+ R := RGB_Float (C_R);
+ G := RGB_Float (C_G);
+ B := RGB_Float (C_B);
+ return Confirm;
+ else
+ pragma Assert (Result = 0);
+ return Cancel;
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Color_Chooser;
+
+
+ function Color_Chooser
+ (Title : in String;
+ R, G, B : in out RGB_Int;
+ Mode : in FLTK.Widgets.Groups.Color_Choosers.Color_Mode :=
+ FLTK.Widgets.Groups.Color_Choosers.RGB)
+ return Confirm_Result
+ is
+ C_R : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (R);
+ C_G : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (G);
+ C_B : Interfaces.C.unsigned_char := Interfaces.C.unsigned_char (B);
+ M : Interfaces.C.int := FLTK.Widgets.Groups.Color_Choosers.Color_Mode'Pos (Mode);
+ Result : Interfaces.C.int := fl_ask_color_chooser2
+ (Interfaces.C.To_C (Title), C_R, C_G, C_B, M);
+ begin
+ if Result = 1 then
+ R := RGB_Int (C_R);
+ G := RGB_Int (C_G);
+ B := RGB_Int (C_B);
+ return Confirm;
+ else
+ pragma Assert (Result = 0);
+ return Cancel;
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Color_Chooser;
+
+
+ function Dir_Chooser
+ (Message, Default : in String;
+ Relative : in Boolean := False)
+ return String
+ is
+ Result : Interfaces.C.Strings.chars_ptr := fl_ask_dir_chooser
+ (Interfaces.C.To_C (Message),
+ Interfaces.C.To_C (Default),
+ Boolean'Pos (Relative));
+ begin
+ -- Result does not need dealloc
+ if Result = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Result);
+ end if;
+ end Dir_Chooser;
+
+
+ function File_Chooser
+ (Message, Filter_Pattern, Default : in String;
+ Relative : in Boolean := False)
+ return String
+ is
+ Result : Interfaces.C.Strings.chars_ptr := fl_ask_file_chooser
+ (Interfaces.C.To_C (Message),
+ Interfaces.C.To_C (Filter_Pattern),
+ Interfaces.C.To_C (Default),
+ Boolean'Pos (Relative));
+ begin
+ -- Result does not need dealloc
+ if Result = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Result);
+ end if;
+ end File_Chooser;
+
+
+ procedure Set_File_Chooser_Callback
+ (Func : in File_Chooser_Callback) is
+ begin
+ Chooser_Func := Func;
+ end Set_File_Chooser_Callback;
+
+
+ procedure Set_File_Chooser_OK_String
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Chooser_OK_Str);
+ Chooser_OK_Str := Interfaces.C.Strings.New_String (Value);
+ fl_ask_file_chooser_ok_label (Chooser_OK_Str);
+ end Set_File_Chooser_OK_String;
+
+
+
+
+ function Get_Message_Hotspot
+ return Boolean is
+ begin
+ return fl_ask_get_message_hotspot /= 0;
+ end Get_Message_Hotspot;
+
+
+ procedure Set_Message_Hotspot
+ (To : in Boolean) is
+ begin
+ fl_ask_set_message_hotspot (Boolean'Pos (To));
+ end Set_Message_Hotspot;
+
+
+ procedure Set_Message_Font
+ (Font : in Font_Kind;
+ Size : in Font_Size) is
+ begin
+ fl_ask_message_font (Font_Kind'Pos (Font), Interfaces.C.int (Size));
+ end Set_Message_Font;
+
+
+ function Get_Message_Icon
+ return FLTK.Widgets.Boxes.Box_Reference is
+ begin
+ return (Data => Icon_Box'Access);
+ end Get_Message_Icon;
+
+
+ procedure Set_Message_Title
+ (To : in String) is
+ begin
+ fl_ask_message_title (Interfaces.C.To_C (To));
+ end Set_Message_Title;
+
+
+ procedure Set_Message_Title_Default
+ (To : in String) is
+ begin
+ fl_ask_message_title_default (Interfaces.C.To_C (To));
+ end Set_Message_Title_Default;
+
+
+
+
+begin
+
+
+ Wrapper (Icon_Box).Void_Ptr := fl_ask_message_icon;
+ Wrapper (Icon_Box).Needs_Dealloc := False;
+
+ fl_ask_file_chooser_callback (Storage.To_Integer (File_Chooser_Callback_Hook'Address));
+
+
+end FLTK.Asks;
+
diff --git a/body/fltk-devices-graphics.adb b/body/fltk-devices-graphics.adb
new file mode 100644
index 0000000..f97cebe
--- /dev/null
+++ b/body/fltk-devices-graphics.adb
@@ -0,0 +1,171 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Devices.Graphics is
+
+
+ function fl_graphics_driver_color
+ (G : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_graphics_driver_color, "fl_graphics_driver_color");
+ pragma Inline (fl_graphics_driver_color);
+
+
+
+
+ function fl_graphics_driver_descent
+ (G : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_graphics_driver_descent, "fl_graphics_driver_descent");
+ pragma Inline (fl_graphics_driver_descent);
+
+ function fl_graphics_driver_height
+ (G : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_graphics_driver_height, "fl_graphics_driver_height");
+ pragma Inline (fl_graphics_driver_height);
+
+ function fl_graphics_driver_width
+ (G : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned)
+ return Interfaces.C.double;
+ pragma Import (C, fl_graphics_driver_width, "fl_graphics_driver_width");
+ pragma Inline (fl_graphics_driver_width);
+
+ function fl_graphics_driver_width2
+ (G : in Storage.Integer_Address;
+ S : in Interfaces.C.char_array;
+ L : in Interfaces.C.int)
+ return Interfaces.C.double;
+ pragma Import (C, fl_graphics_driver_width2, "fl_graphics_driver_width2");
+ pragma Inline (fl_graphics_driver_width2);
+
+ function fl_graphics_driver_get_font
+ (G : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_graphics_driver_get_font, "fl_graphics_driver_get_font");
+ pragma Inline (fl_graphics_driver_get_font);
+
+ function fl_graphics_driver_size
+ (G : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_graphics_driver_size, "fl_graphics_driver_size");
+ pragma Inline (fl_graphics_driver_size);
+
+ procedure fl_graphics_driver_set_font
+ (G : in Storage.Integer_Address;
+ K, S : in Interfaces.C.int);
+ pragma Import (C, fl_graphics_driver_set_font, "fl_graphics_driver_set_font");
+ pragma Inline (fl_graphics_driver_set_font);
+
+
+
+
+ procedure fl_graphics_driver_draw_scaled
+ (G, I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_graphics_driver_draw_scaled, "fl_graphics_driver_draw_scaled");
+ pragma Inline (fl_graphics_driver_draw_scaled);
+
+
+
+
+ function Get_Color
+ (This : in Graphics_Driver)
+ return Color is
+ begin
+ return Color (fl_graphics_driver_color (This.Void_Ptr));
+ end Get_Color;
+
+
+
+
+ function Get_Text_Descent
+ (This : in Graphics_Driver)
+ return Integer is
+ begin
+ return Integer (fl_graphics_driver_descent (This.Void_Ptr));
+ end Get_Text_Descent;
+
+
+ function Get_Line_Height
+ (This : in Graphics_Driver)
+ return Integer is
+ begin
+ return Integer (fl_graphics_driver_height (This.Void_Ptr));
+ end Get_Line_Height;
+
+
+ function Get_Width
+ (This : in Graphics_Driver;
+ Char : in Character)
+ return Long_Float is
+ begin
+ return Long_Float (fl_graphics_driver_width (This.Void_Ptr, Character'Pos (Char)));
+ end Get_Width;
+
+
+ function Get_Width
+ (This : in Graphics_Driver;
+ Str : in String)
+ return Long_Float is
+ begin
+ return Long_Float (fl_graphics_driver_width2
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Str),
+ Str'Length));
+ end Get_Width;
+
+
+ function Get_Font_Kind
+ (This : in Graphics_Driver)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_graphics_driver_get_font (This.Void_Ptr));
+ end Get_Font_Kind;
+
+
+ function Get_Font_Size
+ (This : in Graphics_Driver)
+ return Font_Size is
+ begin
+ return Font_Size (fl_graphics_driver_size (This.Void_Ptr));
+ end Get_Font_Size;
+
+
+ procedure Set_Font
+ (This : in Graphics_Driver;
+ Face : in Font_Kind;
+ Size : in Font_Size) is
+ begin
+ fl_graphics_driver_set_font (This.Void_Ptr, Font_Kind'Pos (Face), Interfaces.C.int (Size));
+ end Set_Font;
+
+
+
+
+ procedure Draw_Scaled_Image
+ (This : in Graphics_Driver;
+ Img : in FLTK.Images.Image'Class;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_graphics_driver_draw_scaled
+ (This.Void_Ptr,
+ Wrapper (Img).Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Draw_Scaled_Image;
+
+
+end FLTK.Devices.Graphics;
+
diff --git a/body/fltk-devices-surface-copy.adb b/body/fltk-devices-surface-copy.adb
new file mode 100644
index 0000000..7bb1c66
--- /dev/null
+++ b/body/fltk-devices-surface-copy.adb
@@ -0,0 +1,156 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Devices.Surface.Copy is
+
+
+ function new_fl_copy_surface
+ (W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_copy_surface, "new_fl_copy_surface");
+ pragma Inline (new_fl_copy_surface);
+
+ procedure free_fl_copy_surface
+ (S : in Storage.Integer_Address);
+ pragma Import (C, free_fl_copy_surface, "free_fl_copy_surface");
+ pragma Inline (free_fl_copy_surface);
+
+
+
+
+ function fl_copy_surface_get_w
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_copy_surface_get_w, "fl_copy_surface_get_w");
+ pragma Inline (fl_copy_surface_get_w);
+
+ function fl_copy_surface_get_h
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_copy_surface_get_h, "fl_copy_surface_get_h");
+ pragma Inline (fl_copy_surface_get_h);
+
+
+
+
+ procedure fl_copy_surface_draw
+ (S, W : in Storage.Integer_Address;
+ OX, OY : in Interfaces.C.int);
+ pragma Import (C, fl_copy_surface_draw, "fl_copy_surface_draw");
+ pragma Inline (fl_copy_surface_draw);
+
+ procedure fl_copy_surface_draw_decorated_window
+ (S, W : in Storage.Integer_Address;
+ OX, OY : in Interfaces.C.int);
+ pragma Import (C, fl_copy_surface_draw_decorated_window,
+ "fl_copy_surface_draw_decorated_window");
+ pragma Inline (fl_copy_surface_draw_decorated_window);
+
+
+
+
+ procedure fl_copy_surface_set_current
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_copy_surface_set_current, "fl_copy_surface_set_current");
+ pragma Inline (fl_copy_surface_set_current);
+
+
+
+
+ procedure Finalize
+ (This : in out Copy_Surface) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_copy_surface (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ package body Forge is
+
+ function Create
+ (W, H : in Natural)
+ return Copy_Surface is
+ begin
+ return This : Copy_Surface do
+ This.Void_Ptr := new_fl_copy_surface
+ (Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end return;
+ end Create;
+
+ pragma Inline (Create);
+
+ end Forge;
+
+
+
+
+ function Get_W
+ (This : in Copy_Surface)
+ return Integer is
+ begin
+ return Integer (fl_copy_surface_get_w (This.Void_Ptr));
+ end Get_W;
+
+
+ function Get_H
+ (This : in Copy_Surface)
+ return Integer is
+ begin
+ return Integer (fl_copy_surface_get_h (This.Void_Ptr));
+ end Get_H;
+
+
+
+
+ procedure Draw_Widget
+ (This : in out Copy_Surface;
+ Item : in FLTK.Widgets.Widget'Class;
+ Offset_X, Offset_Y : in Integer := 0) is
+ begin
+ fl_copy_surface_draw
+ (This.Void_Ptr,
+ Wrapper (Item).Void_Ptr,
+ Interfaces.C.int (Offset_X),
+ Interfaces.C.int (Offset_Y));
+ end Draw_Widget;
+
+
+ procedure Draw_Decorated_Window
+ (This : in out Copy_Surface;
+ Item : in FLTK.Widgets.Groups.Windows.Window'Class;
+ Offset_X, Offset_Y : in Integer := 0) is
+ begin
+ fl_copy_surface_draw_decorated_window
+ (This.Void_Ptr,
+ Wrapper (Item).Void_Ptr,
+ Interfaces.C.int (Offset_X),
+ Interfaces.C.int (Offset_Y));
+ end Draw_Decorated_Window;
+
+
+
+
+ procedure Set_Current
+ (This : in out Copy_Surface) is
+ begin
+ fl_copy_surface_set_current (This.Void_Ptr);
+ This.Set_Current_Bookkeep;
+ end Set_Current;
+
+
+end FLTK.Devices.Surface.Copy;
+
+
diff --git a/body/fltk-devices-surface-display.adb b/body/fltk-devices-surface-display.adb
new file mode 100644
index 0000000..ad35012
--- /dev/null
+++ b/body/fltk-devices-surface-display.adb
@@ -0,0 +1,118 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+package body FLTK.Devices.Surface.Display is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_display_device
+ (G : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_display_device, "new_fl_display_device");
+ pragma Inline (new_fl_display_device);
+
+ procedure free_fl_display_device
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_display_device, "free_fl_display_device");
+ pragma Inline (free_fl_display_device);
+
+
+
+
+ function fl_display_device_display_device
+ return Storage.Integer_Address;
+ pragma Import (C, fl_display_device_display_device, "fl_display_device_display_device");
+ pragma Inline (fl_display_device_display_device);
+
+
+
+
+ function fl_surface_device_get_driver
+ (S : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_surface_device_get_driver, "fl_surface_device_get_driver");
+ pragma Inline (fl_surface_device_get_driver);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Finalize
+ (This : in out Display_Device) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_display_device (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (Graphics : in out FLTK.Devices.Graphics.Graphics_Driver)
+ return Display_Device is
+ begin
+ return This : Display_Device do
+ This.Void_Ptr := new_fl_display_device (Wrapper (Graphics).Void_Ptr);
+ This.My_Driver := Graphics'Unchecked_Access;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -------------------------
+ -- Static Attributes --
+ -------------------------
+
+ Platform_Display : aliased Display_Device;
+ Platform_Graphics : aliased FLTK.Devices.Graphics.Graphics_Driver;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Platform_Display
+ return Display_Device_Reference is
+ begin
+ return Ref : Display_Device_Reference (Data => Platform_Display'Access);
+ end Get_Platform_Display;
+
+
+begin
+
+
+ Platform_Display.Void_Ptr := fl_display_device_display_device;
+ Platform_Display.Needs_Dealloc := False;
+
+ Wrapper (Platform_Graphics).Void_Ptr :=
+ fl_surface_device_get_driver (Platform_Display.Void_Ptr);
+ Wrapper (Platform_Graphics).Needs_Dealloc := False;
+
+ Platform_Display.My_Driver := Platform_Graphics'Access;
+
+
+end FLTK.Devices.Surface.Display;
+
+
diff --git a/body/fltk-devices-surface-image.adb b/body/fltk-devices-surface-image.adb
new file mode 100644
index 0000000..e9e7de4
--- /dev/null
+++ b/body/fltk-devices-surface-image.adb
@@ -0,0 +1,171 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Devices.Surface.Image is
+
+
+ function new_fl_image_surface
+ (W, H, R : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_image_surface, "new_fl_image_surface");
+ pragma Inline (new_fl_image_surface);
+
+ procedure free_fl_image_surface
+ (S : in Storage.Integer_Address);
+ pragma Import (C, free_fl_image_surface, "free_fl_image_surface");
+ pragma Inline (free_fl_image_surface);
+
+
+
+
+ procedure fl_image_surface_draw
+ (S, I : in Storage.Integer_Address;
+ OX, OY : in Interfaces.C.int);
+ pragma Import (C, fl_image_surface_draw, "fl_image_surface_draw");
+ pragma Inline (fl_image_surface_draw);
+
+ procedure fl_image_surface_draw_decorated_window
+ (S, I : in Storage.Integer_Address;
+ OX, OY : in Interfaces.C.int);
+ pragma Import (C, fl_image_surface_draw_decorated_window,
+ "fl_image_surface_draw_decorated_window");
+ pragma Inline (fl_image_surface_draw_decorated_window);
+
+
+
+
+ function fl_image_surface_image
+ (S : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_image_surface_image, "fl_image_surface_image");
+ pragma Inline (fl_image_surface_image);
+
+ function fl_image_surface_highres_image
+ (S : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_image_surface_highres_image, "fl_image_surface_highres_image");
+ pragma Inline (fl_image_surface_highres_image);
+
+
+
+
+ procedure fl_image_surface_set_current
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_image_surface_set_current, "fl_image_surface_set_current");
+ pragma Inline (fl_image_surface_set_current);
+
+
+
+
+ procedure Finalize
+ (This : in out Image_Surface) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_image_surface (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ package body Forge is
+
+ function Create
+ (W, H : in Integer;
+ Highres : in Boolean := False)
+ return Image_Surface is
+ begin
+ return This : Image_Surface do
+ This.Void_Ptr := new_fl_image_surface
+ (Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Boolean'Pos (Highres));
+ This.High := Highres;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ function Is_Highres
+ (This : in Image_Surface)
+ return Boolean is
+ begin
+ return This.High;
+ end Is_Highres;
+
+
+
+
+ procedure Draw_Widget
+ (This : in out Image_Surface;
+ Item : in FLTK.Widgets.Widget'Class;
+ Offset_X, Offset_Y : in Integer := 0) is
+ begin
+ fl_image_surface_draw
+ (This.Void_Ptr,
+ Wrapper (Item).Void_Ptr,
+ Interfaces.C.int (Offset_X),
+ Interfaces.C.int (Offset_Y));
+ end Draw_Widget;
+
+
+ procedure Draw_Decorated_Window
+ (This : in out Image_Surface;
+ Item : in FLTK.Widgets.Groups.Windows.Window'Class;
+ Offset_X, Offset_Y : in Integer := 0) is
+ begin
+ fl_image_surface_draw_decorated_window
+ (This.Void_Ptr,
+ Wrapper (Item).Void_Ptr,
+ Interfaces.C.int (Offset_X),
+ Interfaces.C.int (Offset_Y));
+ end Draw_Decorated_Window;
+
+
+
+
+ function Get_Image
+ (This : in Image_Surface)
+ return FLTK.Images.RGB.RGB_Image is
+ begin
+ return Img : FLTK.Images.RGB.RGB_Image do
+ Wrapper (Img).Void_Ptr := fl_image_surface_image (This.Void_Ptr);
+ end return;
+ end Get_Image;
+
+
+ function Get_Highres_Image
+ (This : in Image_Surface)
+ return FLTK.Images.Shared.Shared_Image is
+ begin
+ return Img : FLTK.Images.Shared.Shared_Image do
+ Wrapper (Img).Void_Ptr := fl_image_surface_highres_image (This.Void_Ptr);
+ end return;
+ end Get_Highres_Image;
+
+
+
+
+ procedure Set_Current
+ (This : in out Image_Surface) is
+ begin
+ fl_image_surface_set_current (This.Void_Ptr);
+ This.Set_Current_Bookkeep;
+ end Set_Current;
+
+
+end FLTK.Devices.Surface.Image;
+
+
diff --git a/body/fltk-devices-surface-paged-postscript.adb b/body/fltk-devices-surface-paged-postscript.adb
new file mode 100644
index 0000000..fa9f66d
--- /dev/null
+++ b/body/fltk-devices-surface-paged-postscript.adb
@@ -0,0 +1,505 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Devices.Surface.Paged.Postscript is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function fopen
+ (Name, Mode : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, fopen, "fopen");
+
+ function fclose
+ (Handle : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fclose, "fclose");
+
+
+
+
+ function new_fl_postscript_file_device
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_postscript_file_device, "new_fl_postscript_file_device");
+ pragma Inline (new_fl_postscript_file_device);
+
+ procedure free_fl_postscript_file_device
+ (P : in Storage.Integer_Address);
+ pragma Import (C, free_fl_postscript_file_device, "free_fl_postscript_file_device");
+ pragma Inline (free_fl_postscript_file_device);
+
+
+
+
+ function fl_postscript_file_device_get_file_chooser_title
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_postscript_file_device_get_file_chooser_title,
+ "fl_postscript_file_device_get_file_chooser_title");
+ pragma Inline (fl_postscript_file_device_get_file_chooser_title);
+
+ procedure fl_postscript_file_device_set_file_chooser_title
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_postscript_file_device_set_file_chooser_title,
+ "fl_postscript_file_device_set_file_chooser_title");
+ pragma Inline (fl_postscript_file_device_set_file_chooser_title);
+
+
+
+
+ function fl_postscript_file_device_get_driver
+ (D : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_postscript_file_device_get_driver, "fl_postscript_file_device_get_driver");
+ pragma Inline (fl_postscript_file_device_get_driver);
+
+
+
+
+ function fl_postscript_file_device_start_job
+ (D : in Storage.Integer_Address;
+ C : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_postscript_file_device_start_job, "fl_postscript_file_device_start_job");
+ pragma Inline (fl_postscript_file_device_start_job);
+
+ function fl_postscript_file_device_start_job2
+ (D : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ F, T : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_postscript_file_device_start_job2, "fl_postscript_file_device_start_job2");
+ pragma Inline (fl_postscript_file_device_start_job2);
+
+ function fl_postscript_file_device_start_job3
+ (D, O : in Storage.Integer_Address;
+ C, F, L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_postscript_file_device_start_job3, "fl_postscript_file_device_start_job3");
+ pragma Inline (fl_postscript_file_device_start_job3);
+
+ function fl_postscript_file_device_start_job4
+ (D : in Storage.Integer_Address;
+ C, F, L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_postscript_file_device_start_job4, "fl_postscript_file_device_start_job4");
+ pragma Inline (fl_postscript_file_device_start_job4);
+
+ procedure fl_postscript_file_device_end_job
+ (D : in Storage.Integer_Address);
+ pragma Import (C, fl_postscript_file_device_end_job, "fl_postscript_file_device_end_job");
+ pragma Inline (fl_postscript_file_device_end_job);
+
+ function fl_postscript_file_device_start_page
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_postscript_file_device_start_page, "fl_postscript_file_device_start_page");
+ pragma Inline (fl_postscript_file_device_start_page);
+
+ function fl_postscript_file_device_end_page
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_postscript_file_device_end_page, "fl_postscript_file_device_end_page");
+ pragma Inline (fl_postscript_file_device_end_page);
+
+
+
+
+ procedure fl_postscript_file_device_margins
+ (D : in Storage.Integer_Address;
+ L, T, R, B : out Interfaces.C.int);
+ pragma Import (C, fl_postscript_file_device_margins, "fl_postscript_file_device_margins");
+ pragma Inline (fl_postscript_file_device_margins);
+
+ function fl_postscript_file_device_printable_rect
+ (D : in Storage.Integer_Address;
+ W, H : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_postscript_file_device_printable_rect,
+ "fl_postscript_file_device_printable_rect");
+ pragma Inline (fl_postscript_file_device_printable_rect);
+
+ procedure fl_postscript_file_device_get_origin
+ (D : in Storage.Integer_Address;
+ X, Y : out Interfaces.C.int);
+ pragma Import (C, fl_postscript_file_device_get_origin, "fl_postscript_file_device_get_origin");
+ pragma Inline (fl_postscript_file_device_get_origin);
+
+ procedure fl_postscript_file_device_set_origin
+ (D : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_postscript_file_device_set_origin, "fl_postscript_file_device_set_origin");
+ pragma Inline (fl_postscript_file_device_set_origin);
+
+ procedure fl_postscript_file_device_rotate
+ (D : in Storage.Integer_Address;
+ R : in Interfaces.C.C_float);
+ pragma Import (C, fl_postscript_file_device_rotate, "fl_postscript_file_device_rotate");
+ pragma Inline (fl_postscript_file_device_rotate);
+
+ procedure fl_postscript_file_device_scale
+ (D : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.C_float);
+ pragma Import (C, fl_postscript_file_device_scale, "fl_postscript_file_device_scale");
+ pragma Inline (fl_postscript_file_device_scale);
+
+ procedure fl_postscript_file_device_translate
+ (D : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_postscript_file_device_translate, "fl_postscript_file_device_translate");
+ pragma Inline (fl_postscript_file_device_translate);
+
+ procedure fl_postscript_file_device_untranslate
+ (D : in Storage.Integer_Address);
+ pragma Import (C, fl_postscript_file_device_untranslate,
+ "fl_postscript_file_device_untranslate");
+ pragma Inline (fl_postscript_file_device_untranslate);
+
+
+
+
+ -----------------------------
+ -- Auxiliary Subprograms --
+ -----------------------------
+
+ procedure Open
+ (File : in out File_Type;
+ Name : in String)
+ is
+ Result : Storage.Integer_Address;
+ begin
+ File.Close;
+ Result := fopen
+ (Interfaces.C.To_C (Name),
+ Interfaces.C.To_C ("w"));
+ if Result = Null_Pointer then
+ raise File_Open_Error;
+ else
+ File.C_File := Result;
+ File.Open_State := True;
+ end if;
+ end Open;
+
+
+ function Is_Open
+ (File : in File_Type)
+ return Boolean is
+ begin
+ return File.Open_State;
+ end Is_Open;
+
+
+ procedure Close
+ (File : in out File_Type)
+ is
+ Result : Interfaces.C.int;
+ begin
+ if File.Is_Open then
+ Result := fclose (File.C_File);
+ if Result /= 0 then
+ raise File_Close_Error;
+ end if;
+ File.Open_State := False;
+ end if;
+ end Close;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Finalize
+ (This : in out File_Type) is
+ begin
+ This.Close;
+ end Finalize;
+
+
+ procedure Finalize
+ (This : in out Postscript_File_Device) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_postscript_file_device (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+ procedure Finalize
+ (This : in out Postscript_File_Device_Final_Controller) is
+ begin
+ Interfaces.C.Strings.Free (File_Chooser_Title);
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ return Postscript_File_Device is
+ begin
+ return This : Postscript_File_Device do
+ This.Void_Ptr := new_fl_postscript_file_device;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -------------------------
+ -- Static Attributes --
+ -------------------------
+
+ function Get_File_Chooser_Title
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_postscript_file_device_get_file_chooser_title);
+ end Get_File_Chooser_Title;
+
+
+ procedure Set_File_Chooser_Title
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (File_Chooser_Title);
+ File_Chooser_Title := Interfaces.C.Strings.New_String (Value);
+ fl_postscript_file_device_set_file_chooser_title (File_Chooser_Title);
+ end Set_File_Chooser_Title;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Postscript_Driver
+ (This : in out Postscript_File_Device)
+ return FLTK.Devices.Graphics.Graphics_Driver_Reference is
+ begin
+ return raise Program_Error with "Get_Postscript_Driver unimplemented";
+ end Get_Postscript_Driver;
+
+
+
+
+ procedure Start_Job
+ (This : in out Postscript_File_Device;
+ Count : in Natural := 0) is
+ begin
+ if fl_postscript_file_device_start_job
+ (This.Void_Ptr, Interfaces.C.int (Count)) /= 0
+ then
+ raise Page_Error;
+ end if;
+ end Start_Job;
+
+
+ procedure Start_Job
+ (This : in out Postscript_File_Device;
+ Count : in Natural := 0;
+ From, To : out Positive) is
+ begin
+ if fl_postscript_file_device_start_job2
+ (This.Void_Ptr,
+ Interfaces.C.int (Count),
+ Interfaces.C.int (From),
+ Interfaces.C.int (To)) /= 0
+ then
+ raise Page_Error;
+ end if;
+ end Start_Job;
+
+
+ procedure Start_Job
+ (This : in out Postscript_File_Device;
+ Output : in File_Type'Class;
+ Count : in Natural := 0;
+ Format : in Page_Format := A4;
+ Layout : in Page_Layout := Portrait)
+ is
+ Code : Interfaces.C.int := fl_postscript_file_device_start_job3
+ (This.Void_Ptr,
+ Output.C_File,
+ Interfaces.C.int (Count),
+ To_Cint (Format),
+ To_Cint (Layout));
+ begin
+ pragma Assert (Code = 0);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Start_Job;
+
+
+ procedure Start_Job
+ (This : in out Postscript_File_Device;
+ Count : in Natural := 0;
+ Format : in Page_Format := A4;
+ Layout : in Page_Layout := Portrait)
+ is
+ Code : Interfaces.C.int := fl_postscript_file_device_start_job4
+ (This.Void_Ptr,
+ Interfaces.C.int (Count),
+ To_Cint (Format),
+ To_Cint (Layout));
+ begin
+ case Code is
+ when 1 => raise User_Cancel_Error;
+ when 2 => raise File_Open_Error;
+ when others => pragma Assert (Code = 0);
+ end case;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Start_Job;
+
+
+ procedure End_Job
+ (This : in out Postscript_File_Device) is
+ begin
+ fl_postscript_file_device_end_job (This.Void_Ptr);
+ end End_Job;
+
+
+ procedure Start_Page
+ (This : in out Postscript_File_Device) is
+ begin
+ if fl_postscript_file_device_start_page (This.Void_Ptr) /= 0 then
+ raise Page_Error;
+ end if;
+ end Start_Page;
+
+
+ procedure End_Page
+ (This : in out Postscript_File_Device) is
+ begin
+ if fl_postscript_file_device_end_page (This.Void_Ptr) /= 0 then
+ raise Page_Error;
+ end if;
+ end End_Page;
+
+
+
+
+ procedure Get_Margins
+ (This : in Postscript_File_Device;
+ Left, Top, Right, Bottom : out Integer) is
+ begin
+ fl_postscript_file_device_margins
+ (This.Void_Ptr,
+ Interfaces.C.int (Left),
+ Interfaces.C.int (Top),
+ Interfaces.C.int (Right),
+ Interfaces.C.int (Bottom));
+ end Get_Margins;
+
+
+ procedure Get_Printable_Rect
+ (This : in Postscript_File_Device;
+ W, H : out Integer) is
+ begin
+ if fl_postscript_file_device_printable_rect
+ (This.Void_Ptr, Interfaces.C.int (W), Interfaces.C.int (H)) /= 0
+ then
+ raise Page_Error;
+ end if;
+ end Get_Printable_Rect;
+
+
+ procedure Get_Origin
+ (This : in Postscript_File_Device;
+ X, Y : out Integer) is
+ begin
+ fl_postscript_file_device_get_origin
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Get_Origin;
+
+
+ procedure Set_Origin
+ (This : in out Postscript_File_Device;
+ X, Y : in Integer) is
+ begin
+ fl_postscript_file_device_set_origin
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Set_Origin;
+
+
+ procedure Rotate
+ (This : in out Postscript_File_Device;
+ Degrees : in Float) is
+ begin
+ fl_postscript_file_device_rotate (This.Void_Ptr, Interfaces.C.C_float (Degrees));
+ end Rotate;
+
+
+ procedure Scale
+ (This : in out Postscript_File_Device;
+ Factor : in Float) is
+ begin
+ fl_postscript_file_device_scale (This.Void_Ptr, Interfaces.C.C_float (Factor), 0.0);
+ end Scale;
+
+
+ procedure Scale
+ (This : in out Postscript_File_Device;
+ Factor_X, Factor_Y : in Float) is
+ begin
+ fl_postscript_file_device_scale
+ (This.Void_Ptr,
+ Interfaces.C.C_float (Factor_X),
+ Interfaces.C.C_float (Factor_Y));
+ end Scale;
+
+
+ procedure Translate
+ (This : in out Postscript_File_Device;
+ Delta_X, Delta_Y : in Integer) is
+ begin
+ fl_postscript_file_device_translate
+ (This.Void_Ptr,
+ Interfaces.C.int (Delta_X),
+ Interfaces.C.int (Delta_Y));
+ end Translate;
+
+
+ procedure Untranslate
+ (This : in out Postscript_File_Device) is
+ begin
+ fl_postscript_file_device_untranslate (This.Void_Ptr);
+ end Untranslate;
+
+
+end FLTK.Devices.Surface.Paged.Postscript;
+
+
diff --git a/body/fltk-devices-surface-paged-printers.adb b/body/fltk-devices-surface-paged-printers.adb
new file mode 100644
index 0000000..3e605c8
--- /dev/null
+++ b/body/fltk-devices-surface-paged-printers.adb
@@ -0,0 +1,915 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Devices.Surface.Paged.Printers is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_printer
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_printer, "new_fl_printer");
+ pragma Inline (new_fl_printer);
+
+ procedure free_fl_printer
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_printer, "free_fl_printer");
+ pragma Inline (free_fl_printer);
+
+
+
+
+ function fl_printer_get_dialog_title
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_title, "fl_printer_get_dialog_title");
+ pragma Inline (fl_printer_get_dialog_title);
+
+ procedure fl_printer_set_dialog_title
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_title, "fl_printer_set_dialog_title");
+ pragma Inline (fl_printer_set_dialog_title);
+
+ function fl_printer_get_dialog_printer
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_printer, "fl_printer_get_dialog_printer");
+ pragma Inline (fl_printer_get_dialog_printer);
+
+ procedure fl_printer_set_dialog_printer
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_printer, "fl_printer_set_dialog_printer");
+ pragma Inline (fl_printer_set_dialog_printer);
+
+ function fl_printer_get_dialog_range
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_range, "fl_printer_get_dialog_range");
+ pragma Inline (fl_printer_get_dialog_range);
+
+ procedure fl_printer_set_dialog_range
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_range, "fl_printer_set_dialog_range");
+ pragma Inline (fl_printer_set_dialog_range);
+
+ function fl_printer_get_dialog_copies
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_copies, "fl_printer_get_dialog_copies");
+ pragma Inline (fl_printer_get_dialog_copies);
+
+ procedure fl_printer_set_dialog_copies
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_copies, "fl_printer_set_dialog_copies");
+ pragma Inline (fl_printer_set_dialog_copies);
+
+ function fl_printer_get_dialog_all
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_all, "fl_printer_get_dialog_all");
+ pragma Inline (fl_printer_get_dialog_all);
+
+ procedure fl_printer_set_dialog_all
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_all, "fl_printer_set_dialog_all");
+ pragma Inline (fl_printer_set_dialog_all);
+
+ function fl_printer_get_dialog_pages
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_pages, "fl_printer_get_dialog_pages");
+ pragma Inline (fl_printer_get_dialog_pages);
+
+ procedure fl_printer_set_dialog_pages
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_pages, "fl_printer_set_dialog_pages");
+ pragma Inline (fl_printer_set_dialog_pages);
+
+ function fl_printer_get_dialog_from
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_from, "fl_printer_get_dialog_from");
+ pragma Inline (fl_printer_get_dialog_from);
+
+ procedure fl_printer_set_dialog_from
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_from, "fl_printer_set_dialog_from");
+ pragma Inline (fl_printer_set_dialog_from);
+
+ function fl_printer_get_dialog_to
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_to, "fl_printer_get_dialog_to");
+ pragma Inline (fl_printer_get_dialog_to);
+
+ procedure fl_printer_set_dialog_to
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_to, "fl_printer_set_dialog_to");
+ pragma Inline (fl_printer_set_dialog_to);
+
+ function fl_printer_get_dialog_properties
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_properties, "fl_printer_get_dialog_properties");
+ pragma Inline (fl_printer_get_dialog_properties);
+
+ procedure fl_printer_set_dialog_properties
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_properties, "fl_printer_set_dialog_properties");
+ pragma Inline (fl_printer_set_dialog_properties);
+
+ function fl_printer_get_dialog_copyno
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_copyno, "fl_printer_get_dialog_copyno");
+ pragma Inline (fl_printer_get_dialog_copyno);
+
+ procedure fl_printer_set_dialog_copyno
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_copyno, "fl_printer_set_dialog_copyno");
+ pragma Inline (fl_printer_set_dialog_copyno);
+
+ function fl_printer_get_dialog_print_button
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_print_button, "fl_printer_get_dialog_print_button");
+ pragma Inline (fl_printer_get_dialog_print_button);
+
+ procedure fl_printer_set_dialog_print_button
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_print_button, "fl_printer_set_dialog_print_button");
+ pragma Inline (fl_printer_set_dialog_print_button);
+
+ function fl_printer_get_dialog_cancel_button
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_cancel_button, "fl_printer_get_dialog_cancel_button");
+ pragma Inline (fl_printer_get_dialog_cancel_button);
+
+ procedure fl_printer_set_dialog_cancel_button
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_cancel_button, "fl_printer_set_dialog_cancel_button");
+ pragma Inline (fl_printer_set_dialog_cancel_button);
+
+ function fl_printer_get_dialog_print_to_file
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_dialog_print_to_file, "fl_printer_get_dialog_print_to_file");
+ pragma Inline (fl_printer_get_dialog_print_to_file);
+
+ procedure fl_printer_set_dialog_print_to_file
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_dialog_print_to_file, "fl_printer_set_dialog_print_to_file");
+ pragma Inline (fl_printer_set_dialog_print_to_file);
+
+ function fl_printer_get_property_title
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_property_title, "fl_printer_get_property_title");
+ pragma Inline (fl_printer_get_property_title);
+
+ procedure fl_printer_set_property_title
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_property_title, "fl_printer_set_property_title");
+ pragma Inline (fl_printer_set_property_title);
+
+ function fl_printer_get_property_pagesize
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_property_pagesize, "fl_printer_get_property_pagesize");
+ pragma Inline (fl_printer_get_property_pagesize);
+
+ procedure fl_printer_set_property_pagesize
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_property_pagesize, "fl_printer_set_property_pagesize");
+ pragma Inline (fl_printer_set_property_pagesize);
+
+ function fl_printer_get_property_mode
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_property_mode, "fl_printer_get_property_mode");
+ pragma Inline (fl_printer_get_property_mode);
+
+ procedure fl_printer_set_property_mode
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_property_mode, "fl_printer_set_property_mode");
+ pragma Inline (fl_printer_set_property_mode);
+
+ function fl_printer_get_property_use
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_property_use, "fl_printer_get_property_use");
+ pragma Inline (fl_printer_get_property_use);
+
+ procedure fl_printer_set_property_use
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_property_use, "fl_printer_set_property_use");
+ pragma Inline (fl_printer_set_property_use);
+
+ function fl_printer_get_property_save
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_property_save, "fl_printer_get_property_save");
+ pragma Inline (fl_printer_get_property_save);
+
+ procedure fl_printer_set_property_save
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_property_save, "fl_printer_set_property_save");
+ pragma Inline (fl_printer_set_property_save);
+
+ function fl_printer_get_property_cancel
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_printer_get_property_cancel, "fl_printer_get_property_cancel");
+ pragma Inline (fl_printer_get_property_cancel);
+
+ procedure fl_printer_set_property_cancel
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_printer_set_property_cancel, "fl_printer_set_property_cancel");
+ pragma Inline (fl_printer_set_property_cancel);
+
+
+
+
+ function fl_printer_start_job
+ (D : in Storage.Integer_Address;
+ C : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_printer_start_job, "fl_printer_start_job");
+ pragma Inline (fl_printer_start_job);
+
+ function fl_printer_start_job2
+ (D : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ F, T : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_printer_start_job2, "fl_printer_start_job2");
+ pragma Inline (fl_printer_start_job2);
+
+ procedure fl_printer_end_job
+ (D : in Storage.Integer_Address);
+ pragma Import (C, fl_printer_end_job, "fl_printer_end_job");
+ pragma Inline (fl_printer_end_job);
+
+ function fl_printer_start_page
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_printer_start_page, "fl_printer_start_page");
+ pragma Inline (fl_printer_start_page);
+
+ function fl_printer_end_page
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_printer_end_page, "fl_printer_end_page");
+ pragma Inline (fl_printer_end_page);
+
+
+
+
+ procedure fl_printer_margins
+ (D : in Storage.Integer_Address;
+ L, T, R, B : out Interfaces.C.int);
+ pragma Import (C, fl_printer_margins, "fl_printer_margins");
+ pragma Inline (fl_printer_margins);
+
+ function fl_printer_printable_rect
+ (D : in Storage.Integer_Address;
+ W, H : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_printer_printable_rect, "fl_printer_printable_rect");
+ pragma Inline (fl_printer_printable_rect);
+
+ procedure fl_printer_get_origin
+ (D : in Storage.Integer_Address;
+ X, Y : out Interfaces.C.int);
+ pragma Import (C, fl_printer_get_origin, "fl_printer_get_origin");
+ pragma Inline (fl_printer_get_origin);
+
+ procedure fl_printer_set_origin
+ (D : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_printer_set_origin, "fl_printer_set_origin");
+ pragma Inline (fl_printer_set_origin);
+
+ procedure fl_printer_rotate
+ (D : in Storage.Integer_Address;
+ R : in Interfaces.C.C_float);
+ pragma Import (C, fl_printer_rotate, "fl_printer_rotate");
+ pragma Inline (fl_printer_rotate);
+
+ procedure fl_printer_scale
+ (D : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.C_float);
+ pragma Import (C, fl_printer_scale, "fl_printer_scale");
+ pragma Inline (fl_printer_scale);
+
+ procedure fl_printer_translate
+ (D : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_printer_translate, "fl_printer_translate");
+ pragma Inline (fl_printer_translate);
+
+ procedure fl_printer_untranslate
+ (D : in Storage.Integer_Address);
+ pragma Import (C, fl_printer_untranslate, "fl_printer_untranslate");
+ pragma Inline (fl_printer_untranslate);
+
+
+
+
+ procedure fl_printer_print_widget
+ (D, I : in Storage.Integer_Address;
+ DX, DY : in Interfaces.C.int);
+ pragma Import (C, fl_printer_print_widget, "fl_printer_print_widget");
+ pragma Inline (fl_printer_print_widget);
+
+ procedure fl_printer_print_window_part
+ (D, I : in Storage.Integer_Address;
+ X, Y, W, H, DX, DY : in Interfaces.C.int);
+ pragma Import (C, fl_printer_print_window_part, "fl_printer_print_window_part");
+ pragma Inline (fl_printer_print_window_part);
+
+
+
+
+ procedure fl_printer_set_current
+ (D : in Storage.Integer_Address);
+ pragma Import (C, fl_printer_set_current, "fl_printer_set_current");
+ pragma Inline (fl_printer_set_current);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Finalize
+ (This : in out Printer) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_printer (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+ procedure Finalize
+ (This : in out Printer_Final_Controller)
+ is
+ use Interfaces.C.Strings;
+ begin
+ Free (Dialog_Title);
+ Free (Dialog_Printer);
+ Free (Dialog_Range);
+ Free (Dialog_Copies);
+ Free (Dialog_All);
+ Free (Dialog_Pages);
+ Free (Dialog_From);
+ Free (Dialog_To);
+ Free (Dialog_Properties);
+ Free (Dialog_Copyno);
+ Free (Dialog_Print_Button);
+ Free (Dialog_Cancel_Button);
+ Free (Dialog_Print_To_File);
+ Free (Property_Title);
+ Free (Property_Pagesize);
+ Free (Property_Mode);
+ Free (Property_Use);
+ Free (Property_Save);
+ Free (Property_Cancel);
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ return Printer is
+ begin
+ return This : Printer do
+ This.Void_Ptr := new_fl_printer;
+ end return;
+ end Create;
+
+ pragma Inline (Create);
+
+ end Forge;
+
+
+
+
+ -------------------------
+ -- Static Attributes --
+ -------------------------
+
+ function Get_Dialog_Title
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_title);
+ end Get_Dialog_Title;
+
+
+ procedure Set_Dialog_Title
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_Title);
+ Dialog_Title := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_title (Dialog_Title);
+ end Set_Dialog_Title;
+
+
+ function Get_Dialog_Printer
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_printer);
+ end Get_Dialog_Printer;
+
+
+ procedure Set_Dialog_Printer
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_Printer);
+ Dialog_Printer := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_printer (Dialog_Printer);
+ end Set_Dialog_Printer;
+
+
+ function Get_Dialog_Range
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_range);
+ end Get_Dialog_Range;
+
+
+ procedure Set_Dialog_Range
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_Range);
+ Dialog_Range := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_range (Dialog_Range);
+ end Set_Dialog_Range;
+
+
+ function Get_Dialog_Copies
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_copies);
+ end Get_Dialog_Copies;
+
+
+ procedure Set_Dialog_Copies
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_Copies);
+ Dialog_Copies := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_copies (Dialog_Copies);
+ end Set_Dialog_Copies;
+
+
+ function Get_Dialog_All
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_all);
+ end Get_Dialog_All;
+
+
+ procedure Set_Dialog_All
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_All);
+ Dialog_All := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_all (Dialog_All);
+ end Set_Dialog_All;
+
+
+ function Get_Dialog_Pages
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_pages);
+ end Get_Dialog_Pages;
+
+
+ procedure Set_Dialog_Pages
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_Pages);
+ Dialog_Pages := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_pages (Dialog_Pages);
+ end Set_Dialog_Pages;
+
+
+ function Get_Dialog_From
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_from);
+ end Get_Dialog_From;
+
+
+ procedure Set_Dialog_From
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_From);
+ Dialog_From := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_from (Dialog_From);
+ end Set_Dialog_From;
+
+
+ function Get_Dialog_To
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_to);
+ end Get_Dialog_To;
+
+
+ procedure Set_Dialog_To
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_To);
+ Dialog_To := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_to (Dialog_To);
+ end Set_Dialog_To;
+
+
+ function Get_Dialog_Properties
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_properties);
+ end Get_Dialog_Properties;
+
+
+ procedure Set_Dialog_Properties
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_Properties);
+ Dialog_Properties := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_properties (Dialog_Properties);
+ end Set_Dialog_Properties;
+
+
+ function Get_Dialog_Number_Copies
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_copyno);
+ end Get_Dialog_Number_Copies;
+
+
+ procedure Set_Dialog_Number_Copies
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_Copyno);
+ Dialog_Copyno := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_copyno (Dialog_Copyno);
+ end Set_Dialog_Number_Copies;
+
+
+ function Get_Dialog_Print_Button
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_print_button);
+ end Get_Dialog_Print_Button;
+
+
+ procedure Set_Dialog_Print_Button
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_Print_Button);
+ Dialog_Print_Button := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_print_button (Dialog_Print_Button);
+ end Set_Dialog_Print_Button;
+
+
+ function Get_Dialog_Cancel_Button
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_cancel_button);
+ end Get_Dialog_Cancel_Button;
+
+
+ procedure Set_Dialog_Cancel_Button
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_Cancel_Button);
+ Dialog_Cancel_Button := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_cancel_button (Dialog_Cancel_Button);
+ end Set_Dialog_Cancel_Button;
+
+
+ function Get_Dialog_Print_To_File
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_dialog_print_to_file);
+ end Get_Dialog_Print_To_File;
+
+
+ procedure Set_Dialog_Print_To_File
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Dialog_Print_To_File);
+ Dialog_Print_To_File := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_dialog_print_to_file (Dialog_Print_To_File);
+ end Set_Dialog_Print_To_File;
+
+
+ function Get_Property_Title
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_property_title);
+ end Get_Property_Title;
+
+
+ procedure Set_Property_Title
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Property_Title);
+ Property_Title := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_property_title (Property_Title);
+ end Set_Property_Title;
+
+
+ function Get_Property_Page_Size
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_property_pagesize);
+ end Get_Property_Page_Size;
+
+
+ procedure Set_Property_Page_Size
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Property_Pagesize);
+ Property_Pagesize := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_property_pagesize (Property_Pagesize);
+ end Set_Property_Page_Size;
+
+
+ function Get_Property_Mode
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_property_mode);
+ end Get_Property_Mode;
+
+
+ procedure Set_Property_Mode
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Property_Mode);
+ Property_Mode := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_property_mode (Property_Mode);
+ end Set_Property_Mode;
+
+
+ function Get_Property_Use
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_property_use);
+ end Get_Property_Use;
+
+
+ procedure Set_Property_Use
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Property_Use);
+ Property_Use := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_property_use (Property_Use);
+ end Set_Property_Use;
+
+
+ function Get_Property_Save
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_property_save);
+ end Get_Property_Save;
+
+
+ procedure Set_Property_Save
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Property_Save);
+ Property_Save := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_property_save (Property_Save);
+ end Set_Property_Save;
+
+
+ function Get_Property_Cancel
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_printer_get_property_cancel);
+ end Get_Property_Cancel;
+
+
+ procedure Set_Property_Cancel
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Property_Cancel);
+ Property_Cancel := Interfaces.C.Strings.New_String (Value);
+ fl_printer_set_property_cancel (Property_Cancel);
+ end Set_Property_Cancel;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Original_Driver
+ (This : in out Printer)
+ return FLTK.Devices.Graphics.Graphics_Driver_Reference is
+ begin
+ return raise Program_Error with "Won't be implemented until Graphics_Drivers taken care of";
+ end Get_Original_Driver;
+
+
+
+
+ procedure Start_Job
+ (This : in out Printer;
+ Count : in Natural := 0) is
+ begin
+ if fl_printer_start_job
+ (This.Void_Ptr, Interfaces.C.int (Count)) /= 0
+ then
+ raise Page_Error;
+ end if;
+ end Start_Job;
+
+
+ procedure Start_Job
+ (This : in out Printer;
+ Count : in Natural := 0;
+ From, To : out Positive) is
+ begin
+ if fl_printer_start_job2
+ (This.Void_Ptr,
+ Interfaces.C.int (Count),
+ Interfaces.C.int (From),
+ Interfaces.C.int (To)) /= 0
+ then
+ raise Page_Error;
+ end if;
+ end Start_Job;
+
+
+ procedure End_Job
+ (This : in out Printer) is
+ begin
+ fl_printer_end_job (This.Void_Ptr);
+ end End_Job;
+
+
+ procedure Start_Page
+ (This : in out Printer) is
+ begin
+ if fl_printer_start_page (This.Void_Ptr) /= 0 then
+ raise Page_Error;
+ end if;
+ end Start_Page;
+
+
+ procedure End_Page
+ (This : in out Printer) is
+ begin
+ if fl_printer_end_page (This.Void_Ptr) /= 0 then
+ raise Page_Error;
+ end if;
+ end End_Page;
+
+
+
+
+ procedure Get_Margins
+ (This : in Printer;
+ Left, Top, Right, Bottom : out Integer) is
+ begin
+ fl_printer_margins
+ (This.Void_Ptr,
+ Interfaces.C.int (Left),
+ Interfaces.C.int (Top),
+ Interfaces.C.int (Right),
+ Interfaces.C.int (Bottom));
+ end Get_Margins;
+
+
+ procedure Get_Printable_Rect
+ (This : in Printer;
+ W, H : out Integer) is
+ begin
+ if fl_printer_printable_rect
+ (This.Void_Ptr, Interfaces.C.int (W), Interfaces.C.int (H)) /= 0
+ then
+ raise Page_Error;
+ end if;
+ end Get_Printable_Rect;
+
+
+ procedure Get_Origin
+ (This : in Printer;
+ X, Y : out Integer) is
+ begin
+ fl_printer_get_origin (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y));
+ end Get_Origin;
+
+
+ procedure Set_Origin
+ (This : in out Printer;
+ X, Y : in Integer) is
+ begin
+ fl_printer_set_origin
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Set_Origin;
+
+
+ procedure Rotate
+ (This : in out Printer;
+ Degrees : in Float) is
+ begin
+ fl_printer_rotate (This.Void_Ptr, Interfaces.C.C_float (Degrees));
+ end Rotate;
+
+
+ procedure Scale
+ (This : in out Printer;
+ Factor : in Float) is
+ begin
+ fl_printer_scale (This.Void_Ptr, Interfaces.C.C_float (Factor), 0.0);
+ end Scale;
+
+
+ procedure Scale
+ (This : in out Printer;
+ Factor_X, Factor_Y : in Float) is
+ begin
+ fl_printer_scale
+ (This.Void_Ptr,
+ Interfaces.C.C_float (Factor_X),
+ Interfaces.C.C_float (Factor_Y));
+ end Scale;
+
+
+ procedure Translate
+ (This : in out Printer;
+ Delta_X, Delta_Y : in Integer) is
+ begin
+ fl_printer_translate
+ (This.Void_Ptr,
+ Interfaces.C.int (Delta_X),
+ Interfaces.C.int (Delta_Y));
+ end Translate;
+
+
+ procedure Untranslate
+ (This : in out Printer) is
+ begin
+ fl_printer_untranslate (This.Void_Ptr);
+ end Untranslate;
+
+
+
+
+ procedure Print_Widget
+ (This : in out Printer;
+ Item : in FLTK.Widgets.Widget'Class;
+ Offset_X, Offset_Y : in Integer := 0) is
+ begin
+ fl_printer_print_widget
+ (This.Void_Ptr,
+ Wrapper (Item).Void_Ptr,
+ Interfaces.C.int (Offset_X),
+ Interfaces.C.int (Offset_Y));
+ end Print_Widget;
+
+
+ procedure Print_Window_Part
+ (This : in out Printer;
+ Item : in FLTK.Widgets.Groups.Windows.Window'Class;
+ X, Y, W, H : in Integer;
+ Offset_X, Offset_Y : in Integer := 0) is
+ begin
+ fl_printer_print_window_part
+ (This.Void_Ptr,
+ Wrapper (Item).Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Offset_X),
+ Interfaces.C.int (Offset_Y));
+ end Print_Window_Part;
+
+
+
+
+ procedure Set_Current
+ (This : in out Printer) is
+ begin
+ fl_printer_set_current (This.Void_Ptr);
+ This.Set_Current_Bookkeep;
+ end Set_Current;
+
+
+end FLTK.Devices.Surface.Paged.Printers;
+
+
diff --git a/body/fltk-devices-surface-paged.adb b/body/fltk-devices-surface-paged.adb
new file mode 100644
index 0000000..829974a
--- /dev/null
+++ b/body/fltk-devices-surface-paged.adb
@@ -0,0 +1,538 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Ada.Strings.Unbounded,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Devices.Surface.Paged is
+
+
+ package Chk renames Ada.Assertions;
+ package SU renames Ada.Strings.Unbounded;
+
+
+
+
+ ------------------------
+ -- Constants From C --
+ ------------------------
+
+ fl_page_format_media : constant Interfaces.C.int;
+ pragma Import (C, fl_page_format_media);
+
+ fl_page_layout_portrait : constant Interfaces.C.int;
+ pragma Import (C, fl_page_layout_portrait);
+
+ fl_page_layout_landscape : constant Interfaces.C.int;
+ pragma Import (C, fl_page_layout_landscape);
+
+ fl_page_layout_reversed : constant Interfaces.C.int;
+ pragma Import (C, fl_page_layout_reversed);
+
+ fl_page_layout_orientation : constant Interfaces.C.int;
+ pragma Import (C, fl_page_layout_orientation);
+
+ fl_no_page_formats : constant Interfaces.C.int;
+ pragma Import (C, fl_no_page_formats);
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ procedure fl_paged_device_get_page_format
+ (Index : in Interfaces.C.int;
+ Name : out Interfaces.C.Strings.chars_ptr;
+ Width : out Interfaces.C.int;
+ Height : out Interfaces.C.int);
+ pragma Import (C, fl_paged_device_get_page_format, "fl_paged_device_get_page_format");
+ pragma Inline (fl_paged_device_get_page_format);
+
+
+
+
+ function new_fl_paged_device
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_paged_device, "new_fl_paged_device");
+ pragma Inline (new_fl_paged_device);
+
+ procedure free_fl_paged_device
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_paged_device, "free_fl_paged_device");
+ pragma Inline (free_fl_paged_device);
+
+
+
+
+ function fl_paged_device_start_job
+ (D : in Storage.Integer_Address;
+ C : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_paged_device_start_job, "fl_paged_device_start_job");
+ pragma Inline (fl_paged_device_start_job);
+
+ function fl_paged_device_start_job2
+ (D : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ F, T : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_paged_device_start_job2, "fl_paged_device_start_job2");
+ pragma Inline (fl_paged_device_start_job2);
+
+ procedure fl_paged_device_end_job
+ (D : in Storage.Integer_Address);
+ pragma Import (C, fl_paged_device_end_job, "fl_paged_device_end_job");
+ pragma Inline (fl_paged_device_end_job);
+
+ function fl_paged_device_start_page
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_paged_device_start_page, "fl_paged_device_start_page");
+ pragma Inline (fl_paged_device_start_page);
+
+ function fl_paged_device_end_page
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_paged_device_end_page, "fl_paged_device_end_page");
+ pragma Inline (fl_paged_device_end_page);
+
+
+
+
+ procedure fl_paged_device_margins
+ (D : in Storage.Integer_Address;
+ L, T, R, B : out Interfaces.C.int);
+ pragma Import (C, fl_paged_device_margins, "fl_paged_device_margins");
+ pragma Inline (fl_paged_device_margins);
+
+ function fl_paged_device_printable_rect
+ (D : in Storage.Integer_Address;
+ W, H : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_paged_device_printable_rect, "fl_paged_device_printable_rect");
+ pragma Inline (fl_paged_device_printable_rect);
+
+ procedure fl_paged_device_get_origin
+ (D : in Storage.Integer_Address;
+ X, Y : out Interfaces.C.int);
+ pragma Import (C, fl_paged_device_get_origin, "fl_paged_device_get_origin");
+ pragma Inline (fl_paged_device_get_origin);
+
+ procedure fl_paged_device_set_origin
+ (D : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_paged_device_set_origin, "fl_paged_device_set_origin");
+ pragma Inline (fl_paged_device_set_origin);
+
+ procedure fl_paged_device_rotate
+ (D : in Storage.Integer_Address;
+ R : in Interfaces.C.C_float);
+ pragma Import (C, fl_paged_device_rotate, "fl_paged_device_rotate");
+ pragma Inline (fl_paged_device_rotate);
+
+ procedure fl_paged_device_scale
+ (D : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.C_float);
+ pragma Import (C, fl_paged_device_scale, "fl_paged_device_scale");
+ pragma Inline (fl_paged_device_scale);
+
+ procedure fl_paged_device_translate
+ (D : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_paged_device_translate, "fl_paged_device_translate");
+ pragma Inline (fl_paged_device_translate);
+
+ procedure fl_paged_device_untranslate
+ (D : in Storage.Integer_Address);
+ pragma Import (C, fl_paged_device_untranslate, "fl_paged_device_untranslate");
+ pragma Inline (fl_paged_device_untranslate);
+
+
+
+
+ procedure fl_paged_device_print_widget
+ (D, I : in Storage.Integer_Address;
+ DX, DY : in Interfaces.C.int);
+ pragma Import (C, fl_paged_device_print_widget, "fl_paged_device_print_widget");
+ pragma Inline (fl_paged_device_print_widget);
+
+ procedure fl_paged_device_print_window
+ (D, I : in Storage.Integer_Address;
+ DX, DY : in Interfaces.C.int);
+ pragma Import (C, fl_paged_device_print_window, "fl_paged_device_print_window");
+ pragma Inline (fl_paged_device_print_window);
+
+ procedure fl_paged_device_print_window_part
+ (D, I : in Storage.Integer_Address;
+ X, Y, W, H, DX, DY : in Interfaces.C.int);
+ pragma Import (C, fl_paged_device_print_window_part, "fl_paged_device_print_window_part");
+ pragma Inline (fl_paged_device_print_window_part);
+
+
+
+
+ ------------------------
+ -- Internal Utility --
+ ------------------------
+
+ function To_Cint
+ (Value : in Page_Format)
+ return Interfaces.C.int is
+ begin
+ case Value is
+ when A0 .. Envelope => return Page_Format'Pos (Value);
+ when Media => return fl_page_format_media;
+ end case;
+ end To_Cint;
+
+
+ function To_Page_Format
+ (Value : in Interfaces.C.int)
+ return Page_Format is
+ begin
+ if Value in Page_Format'Pos (A0) .. Page_Format'Pos (Envelope) then
+ return Page_Format'Val (Value);
+ else
+ pragma Assert (Value = fl_page_format_media);
+ return Media;
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end To_Page_Format;
+
+
+ function To_Cint
+ (Value : in Page_Layout)
+ return Interfaces.C.int is
+ begin
+ case Value is
+ when Portrait => return fl_page_layout_portrait;
+ when Landscape => return fl_page_layout_landscape;
+ when Reversed => return fl_page_layout_reversed;
+ when Orientation => return fl_page_layout_orientation;
+ end case;
+ end To_Cint;
+
+
+ function To_Page_Layout
+ (Value : in Interfaces.C.int)
+ return Page_Layout is
+ begin
+ if Value = fl_page_layout_portrait then
+ return Portrait;
+ elsif Value = fl_page_layout_landscape then
+ return Landscape;
+ elsif Value = fl_page_layout_reversed then
+ return Reversed;
+ else
+ pragma Assert (Value = fl_page_layout_orientation);
+ return Orientation;
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end To_Page_Layout;
+
+
+ function Get_Page_Formats
+ return Page_Format_Info_Array
+ is
+ C_Name : Interfaces.C.Strings.chars_ptr;
+ C_Width : Interfaces.C.int;
+ C_Height : Interfaces.C.int;
+ begin
+ return Data : Page_Format_Info_Array (A0 .. To_Page_Format (fl_no_page_formats - 1)) do
+ for Index in Data'Range loop
+ fl_paged_device_get_page_format (To_Cint (Index), C_Name, C_Width, C_Height);
+ if C_Name = Interfaces.C.Strings.Null_Ptr then
+ Data (Index).My_Name := SU.To_Unbounded_String ("");
+ else
+ Data (Index).My_Name := SU.To_Unbounded_String
+ (Interfaces.C.Strings.Value (C_Name));
+ end if;
+ Data (Index).My_Width := Natural (C_Width);
+ Data (Index).My_Height := Natural (C_Height);
+ end loop;
+ end return;
+ end Get_Page_Formats;
+
+
+
+
+ ----------------------------
+ -- Datatype Subprograms --
+ ----------------------------
+
+ function Name
+ (This : in Page_Format_Info)
+ return String is
+ begin
+ return SU.To_String (This.My_Name);
+ end Name;
+
+
+ function Width
+ (This : in Page_Format_Info)
+ return Natural is
+ begin
+ return This.My_Width;
+ end Width;
+
+
+ function Height
+ (This : in Page_Format_Info)
+ return Natural is
+ begin
+ return This.My_Height;
+ end Height;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Finalize
+ (This : in out Paged_Device) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_paged_device (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ return Paged_Device is
+ begin
+ return This : Paged_Device do
+ This.Void_Ptr := new_fl_paged_device;
+ end return;
+ end Create;
+
+ pragma Inline (Create);
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Start_Job
+ (This : in out Paged_Device;
+ Count : in Natural := 0) is
+ begin
+ if fl_paged_device_start_job
+ (This.Void_Ptr, Interfaces.C.int (Count)) /= 0
+ then
+ raise Page_Error;
+ end if;
+ end Start_Job;
+
+
+ procedure Start_Job
+ (This : in out Paged_Device;
+ Count : in Natural := 0;
+ From, To : out Positive) is
+ begin
+ if fl_paged_device_start_job2
+ (This.Void_Ptr,
+ Interfaces.C.int (Count),
+ Interfaces.C.int (From),
+ Interfaces.C.int (To)) /= 0
+ then
+ raise Page_Error;
+ end if;
+ end Start_Job;
+
+
+ procedure End_Job
+ (This : in out Paged_Device) is
+ begin
+ fl_paged_device_end_job (This.Void_Ptr);
+ end End_Job;
+
+
+ procedure Start_Page
+ (This : in out Paged_Device) is
+ begin
+ if fl_paged_device_start_page (This.Void_Ptr) /= 0 then
+ raise Page_Error;
+ end if;
+ end Start_Page;
+
+
+ procedure End_Page
+ (This : in out Paged_Device) is
+ begin
+ if fl_paged_device_end_page (This.Void_Ptr) /= 0 then
+ raise Page_Error;
+ end if;
+ end End_Page;
+
+
+
+
+ procedure Get_Margins
+ (This : in Paged_Device;
+ Left, Top, Right, Bottom : out Integer) is
+ begin
+ fl_paged_device_margins
+ (This.Void_Ptr,
+ Interfaces.C.int (Left),
+ Interfaces.C.int (Top),
+ Interfaces.C.int (Right),
+ Interfaces.C.int (Bottom));
+ end Get_Margins;
+
+
+ procedure Get_Printable_Rect
+ (This : in Paged_Device;
+ W, H : out Integer) is
+ begin
+ if fl_paged_device_printable_rect
+ (This.Void_Ptr, Interfaces.C.int (W), Interfaces.C.int (H)) /= 0
+ then
+ raise Page_Error;
+ end if;
+ end Get_Printable_Rect;
+
+
+ procedure Get_Origin
+ (This : in Paged_Device;
+ X, Y : out Integer) is
+ begin
+ fl_paged_device_get_origin (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y));
+ end Get_Origin;
+
+
+ procedure Set_Origin
+ (This : in out Paged_Device;
+ X, Y : in Integer) is
+ begin
+ fl_paged_device_set_origin
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Set_Origin;
+
+
+ procedure Rotate
+ (This : in out Paged_Device;
+ Degrees : in Float) is
+ begin
+ fl_paged_device_rotate (This.Void_Ptr, Interfaces.C.C_float (Degrees));
+ end Rotate;
+
+
+ procedure Scale
+ (This : in out Paged_Device;
+ Factor : in Float) is
+ begin
+ fl_paged_device_scale (This.Void_Ptr, Interfaces.C.C_float (Factor), 0.0);
+ end Scale;
+
+
+ procedure Scale
+ (This : in out Paged_Device;
+ Factor_X, Factor_Y : in Float) is
+ begin
+ fl_paged_device_scale
+ (This.Void_Ptr,
+ Interfaces.C.C_float (Factor_X),
+ Interfaces.C.C_float (Factor_Y));
+ end Scale;
+
+
+ procedure Translate
+ (This : in out Paged_Device;
+ Delta_X, Delta_Y : in Integer) is
+ begin
+ fl_paged_device_translate
+ (This.Void_Ptr,
+ Interfaces.C.int (Delta_X),
+ Interfaces.C.int (Delta_Y));
+ end Translate;
+
+
+ procedure Untranslate
+ (This : in out Paged_Device) is
+ begin
+ fl_paged_device_untranslate (This.Void_Ptr);
+ end Untranslate;
+
+
+
+
+ procedure Print_Widget
+ (This : in out Paged_Device;
+ Item : in FLTK.Widgets.Widget'Class;
+ Offset_X, Offset_Y : in Integer := 0) is
+ begin
+ fl_paged_device_print_widget
+ (This.Void_Ptr,
+ Wrapper (Item).Void_Ptr,
+ Interfaces.C.int (Offset_X),
+ Interfaces.C.int (Offset_Y));
+ end Print_Widget;
+
+
+ procedure Print_Window
+ (This : in out Paged_Device;
+ Item : in FLTK.Widgets.Groups.Windows.Window'Class;
+ Offset_X, Offset_Y : in Integer := 0) is
+ begin
+ fl_paged_device_print_window
+ (This.Void_Ptr,
+ Wrapper (Item).Void_Ptr,
+ Interfaces.C.int (Offset_X),
+ Interfaces.C.int (Offset_Y));
+ end Print_Window;
+
+
+ procedure Print_Window_Part
+ (This : in out Paged_Device;
+ Item : in FLTK.Widgets.Groups.Windows.Window'Class;
+ X, Y, W, H : in Integer;
+ Offset_X, Offset_Y : in Integer := 0) is
+ begin
+ fl_paged_device_print_window_part
+ (This.Void_Ptr,
+ Wrapper (Item).Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Offset_X),
+ Interfaces.C.int (Offset_Y));
+ end Print_Window_Part;
+
+
+end FLTK.Devices.Surface.Paged;
+
+
diff --git a/body/fltk-devices-surface.adb b/body/fltk-devices-surface.adb
new file mode 100644
index 0000000..a6ef6cc
--- /dev/null
+++ b/body/fltk-devices-surface.adb
@@ -0,0 +1,180 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+package body FLTK.Devices.Surface is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_surface_device
+ (G : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_surface_device, "new_fl_surface_device");
+ pragma Inline (new_fl_surface_device);
+
+ procedure free_fl_surface_device
+ (S : in Storage.Integer_Address);
+ pragma Import (C, free_fl_surface_device, "free_fl_surface_device");
+ pragma Inline (free_fl_surface_device);
+
+
+
+
+ procedure fl_surface_device_set_current
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_surface_device_set_current, "fl_surface_device_set_current");
+ pragma Inline (fl_surface_device_set_current);
+
+ function fl_surface_device_get_surface
+ return Storage.Integer_Address;
+ pragma Import (C, fl_surface_device_get_surface, "fl_surface_device_get_surface");
+ pragma Inline (fl_surface_device_get_surface);
+
+
+
+
+ function fl_surface_device_get_driver
+ (S : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_surface_device_get_driver, "fl_surface_device_get_driver");
+ pragma Inline (fl_surface_device_get_driver);
+
+ procedure fl_surface_device_set_driver
+ (S, G : in Storage.Integer_Address);
+ pragma Import (C, fl_surface_device_set_driver, "fl_surface_device_set_driver");
+ pragma Inline (fl_surface_device_set_driver);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Finalize
+ (This : in out Surface_Device) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_surface_device (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (Graphics : in out FLTK.Devices.Graphics.Graphics_Driver)
+ return Surface_Device is
+ begin
+ return This : Surface_Device do
+ This.Void_Ptr := new_fl_surface_device (Wrapper (Graphics).Void_Ptr);
+ This.My_Driver := Graphics'Unchecked_Access;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -------------------------
+ -- Static Attributes --
+ -------------------------
+
+ Original_Surface : aliased Surface_Device;
+ Original_Graphics : aliased FLTK.Devices.Graphics.Graphics_Driver;
+
+ Current_Surface : access Surface_Device'Class := Original_Surface'Access;
+
+
+ procedure Set_Current_Bookkeep
+ (Surface : in out Surface_Device'Class) is
+ begin
+ Current_Surface := Surface'Unchecked_Access;
+ end Set_Current_Bookkeep;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Current
+ return Surface_Device_Reference is
+ begin
+ return Ref : Surface_Device_Reference (Data => Current_Surface);
+ end Get_Current;
+
+
+ procedure Set_Current
+ (This : in out Surface_Device) is
+ begin
+ fl_surface_device_set_current (This.Void_Ptr);
+ This.Set_Current_Bookkeep;
+ end Set_Current;
+
+
+ function Get_Original
+ return Surface_Device_Reference is
+ begin
+ return Ref : Surface_Device_Reference (Data => Original_Surface'Access);
+ end Get_Original;
+
+
+
+
+ function Has_Driver
+ (This : in Surface_Device)
+ return Boolean is
+ begin
+ return This.My_Driver /= null and then
+ Wrapper (This.My_Driver.all).Void_Ptr /= Null_Pointer;
+ end Has_Driver;
+
+
+ function Get_Driver
+ (This : in out Surface_Device)
+ return FLTK.Devices.Graphics.Graphics_Driver_Reference is
+ begin
+ return Ref : FLTK.Devices.Graphics.Graphics_Driver_Reference (Data => This.My_Driver);
+ end Get_Driver;
+
+
+ procedure Set_Driver
+ (This : in out Surface_Device;
+ Driver : in out FLTK.Devices.Graphics.Graphics_Driver'Class) is
+ begin
+ fl_surface_device_set_driver (This.Void_Ptr, Wrapper (Driver).Void_Ptr);
+ This.My_Driver := Driver'Unchecked_Access;
+ end Set_Driver;
+
+
+begin
+
+
+ Original_Surface.Void_Ptr := fl_surface_device_get_surface;
+ Original_Surface.Needs_Dealloc := False;
+
+ Wrapper (Original_Graphics).Void_Ptr :=
+ fl_surface_device_get_driver (Original_Surface.Void_Ptr);
+ Wrapper (Original_Graphics).Needs_Dealloc := False;
+
+ Original_Surface.My_Driver := Original_Graphics'Access;
+
+
+end FLTK.Devices.Surface;
+
+
diff --git a/body/fltk-draw.adb b/body/fltk-draw.adb
new file mode 100644
index 0000000..8e98a7f
--- /dev/null
+++ b/body/fltk-draw.adb
@@ -0,0 +1,1897 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Ada.Unchecked_Deallocation,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.size_t;
+
+
+package body FLTK.Draw is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ procedure fl_draw_reset_spot;
+ pragma Import (C, fl_draw_reset_spot, "fl_draw_reset_spot");
+ pragma Inline (fl_draw_reset_spot);
+
+ procedure fl_draw_set_spot
+ (F, S : in Interfaces.C.int;
+ X, Y, W, H : in Interfaces.C.int;
+ Ptr : in Storage.Integer_Address);
+ pragma Import (C, fl_draw_set_spot, "fl_draw_set_spot");
+ pragma Inline (fl_draw_set_spot);
+
+ procedure fl_draw_set_status
+ (X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_draw_set_status, "fl_draw_set_status");
+ pragma Inline (fl_draw_set_status);
+
+
+
+
+ function fl_draw_can_do_alpha_blending
+ return Interfaces.C.int;
+ pragma Import (C, fl_draw_can_do_alpha_blending, "fl_draw_can_do_alpha_blending");
+ pragma Inline (fl_draw_can_do_alpha_blending);
+
+ function fl_draw_shortcut_label
+ (Shortcut : in Interfaces.C.unsigned)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_draw_shortcut_label, "fl_draw_shortcut_label");
+ pragma Inline (fl_draw_shortcut_label);
+
+
+
+
+ function fl_draw_latin1_to_local
+ (T : in Interfaces.C.char_array;
+ N : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_draw_latin1_to_local, "fl_draw_latin1_to_local");
+ pragma Inline (fl_draw_latin1_to_local);
+
+ function fl_draw_local_to_latin1
+ (T : in Interfaces.C.char_array;
+ N : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_draw_local_to_latin1, "fl_draw_local_to_latin1");
+ pragma Inline (fl_draw_local_to_latin1);
+
+ function fl_draw_mac_roman_to_local
+ (T : in Interfaces.C.char_array;
+ N : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_draw_mac_roman_to_local, "fl_draw_mac_roman_to_local");
+ pragma Inline (fl_draw_mac_roman_to_local);
+
+ function fl_draw_local_to_mac_roman
+ (T : in Interfaces.C.char_array;
+ N : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_draw_local_to_mac_roman, "fl_draw_local_to_mac_roman");
+ pragma Inline (fl_draw_local_to_mac_roman);
+
+
+
+
+ function fl_draw_clip_box
+ (X, Y, W, H : in Interfaces.C.int;
+ BX, BY, BW, BH : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_draw_clip_box, "fl_draw_clip_box");
+ pragma Inline (fl_draw_clip_box);
+
+ function fl_draw_not_clipped
+ (X, Y, W, H : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_draw_not_clipped, "fl_draw_not_clipped");
+ pragma Inline (fl_draw_not_clipped);
+
+ procedure fl_draw_pop_clip;
+ pragma Import (C, fl_draw_pop_clip, "fl_draw_pop_clip");
+ pragma Inline (fl_draw_pop_clip);
+
+ procedure fl_draw_push_clip
+ (X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_draw_push_clip, "fl_draw_push_clip");
+ pragma Inline (fl_draw_push_clip);
+
+ procedure fl_draw_push_no_clip;
+ pragma Import (C, fl_draw_push_no_clip, "fl_draw_push_no_clip");
+ pragma Inline (fl_draw_push_no_clip);
+
+ procedure fl_draw_restore_clip;
+ pragma Import (C, fl_draw_restore_clip, "fl_draw_restore_clip");
+ pragma Inline (fl_draw_restore_clip);
+
+
+
+
+ procedure fl_draw_overlay_clear;
+ pragma Import (C, fl_draw_overlay_clear, "fl_draw_overlay_clear");
+ pragma Inline (fl_draw_overlay_clear);
+
+ procedure fl_draw_overlay_rect
+ (X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_draw_overlay_rect, "fl_draw_overlay_rect");
+ pragma Inline (fl_draw_overlay_rect);
+
+
+
+
+ function fl_draw_get_color
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_draw_get_color, "fl_draw_get_color");
+ pragma Inline (fl_draw_get_color);
+
+ procedure fl_draw_set_color
+ (C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_draw_set_color, "fl_draw_set_color");
+ pragma Inline (fl_draw_set_color);
+
+ procedure fl_draw_set_color2
+ (R, G, B : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_draw_set_color2, "fl_draw_set_color2");
+ pragma Inline (fl_draw_set_color2);
+
+ procedure fl_draw_set_cursor
+ (M : in Interfaces.C.int);
+ pragma Import (C, fl_draw_set_cursor, "fl_draw_set_cursor");
+ pragma Inline (fl_draw_set_cursor);
+
+ procedure fl_draw_set_cursor2
+ (M : in Interfaces.C.int;
+ F, B : in Interfaces.C.unsigned);
+ pragma Import (C, fl_draw_set_cursor2, "fl_draw_set_cursor2");
+ pragma Inline (fl_draw_set_cursor2);
+
+ function fl_draw_get_font
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_draw_get_font, "fl_draw_get_font");
+ pragma Inline (fl_draw_get_font);
+
+ function fl_draw_size
+ return Interfaces.C.int;
+ pragma Import (C, fl_draw_size, "fl_draw_size");
+ pragma Inline (fl_draw_size);
+
+ procedure fl_draw_set_font
+ (F : in Interfaces.C.unsigned;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_draw_set_font, "fl_draw_set_font");
+ pragma Inline (fl_draw_set_font);
+
+ function fl_draw_height
+ return Interfaces.C.int;
+ pragma Import (C, fl_draw_height, "fl_draw_height");
+ pragma Inline (fl_draw_height);
+
+ function fl_draw_descent
+ return Interfaces.C.int;
+ pragma Import (C, fl_draw_descent, "fl_draw_descent");
+ pragma Inline (fl_draw_descent);
+
+ function fl_draw_height2
+ (F : in Interfaces.C.unsigned;
+ S : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_draw_height2, "fl_draw_height2");
+ pragma Inline (fl_draw_height2);
+
+ procedure fl_draw_line_style
+ (Style : in Interfaces.C.int;
+ Width : in Interfaces.C.int;
+ Dashes : in Interfaces.C.char_array);
+ pragma Import (C, fl_draw_line_style, "fl_draw_line_style");
+ pragma Inline (fl_draw_line_style);
+
+
+
+
+ procedure fl_draw_mult_matrix
+ (A, B, C, D, X, Y : in Interfaces.C.double);
+ pragma Import (C, fl_draw_mult_matrix, "fl_draw_mult_matrix");
+ pragma Inline (fl_draw_mult_matrix);
+
+ procedure fl_draw_pop_matrix;
+ pragma Import (C, fl_draw_pop_matrix, "fl_draw_pop_matrix");
+ pragma Inline (fl_draw_pop_matrix);
+
+ procedure fl_draw_push_matrix;
+ pragma Import (C, fl_draw_push_matrix, "fl_draw_push_matrix");
+ pragma Inline (fl_draw_push_matrix);
+
+ procedure fl_draw_rotate
+ (D : in Interfaces.C.double);
+ pragma Import (C, fl_draw_rotate, "fl_draw_rotate");
+ pragma Inline (fl_draw_rotate);
+
+ procedure fl_draw_scale
+ (X : in Interfaces.C.double);
+ pragma Import (C, fl_draw_scale, "fl_draw_scale");
+ pragma Inline (fl_draw_scale);
+
+ procedure fl_draw_scale2
+ (X, Y : in Interfaces.C.double);
+ pragma Import (C, fl_draw_scale2, "fl_draw_scale2");
+ pragma Inline (fl_draw_scale2);
+
+ function fl_draw_transform_dx
+ (X, Y : in Interfaces.C.double)
+ return Interfaces.C.double;
+ pragma Import (C, fl_draw_transform_dx, "fl_draw_transform_dx");
+ pragma Inline (fl_draw_transform_dx);
+
+ function fl_draw_transform_dy
+ (X, Y : in Interfaces.C.double)
+ return Interfaces.C.double;
+ pragma Import (C, fl_draw_transform_dy, "fl_draw_transform_dy");
+ pragma Inline (fl_draw_transform_dy);
+
+ function fl_draw_transform_x
+ (X, Y : in Interfaces.C.double)
+ return Interfaces.C.double;
+ pragma Import (C, fl_draw_transform_x, "fl_draw_transform_x");
+ pragma Inline (fl_draw_transform_x);
+
+ function fl_draw_transform_y
+ (X, Y : in Interfaces.C.double)
+ return Interfaces.C.double;
+ pragma Import (C, fl_draw_transform_y, "fl_draw_transform_y");
+ pragma Inline (fl_draw_transform_y);
+
+ procedure fl_draw_transformed_vertex
+ (XF, YF : in Interfaces.C.double);
+ pragma Import (C, fl_draw_transformed_vertex, "fl_draw_transformed_vertex");
+ pragma Inline (fl_draw_transformed_vertex);
+
+ procedure fl_draw_translate
+ (X, Y : in Interfaces.C.double);
+ pragma Import (C, fl_draw_translate, "fl_draw_translate");
+ pragma Inline (fl_draw_translate);
+
+ procedure fl_draw_vertex
+ (X, Y : in Interfaces.C.double);
+ pragma Import (C, fl_draw_vertex, "fl_draw_vertex");
+ pragma Inline (fl_draw_vertex);
+
+
+
+
+ procedure fl_draw_draw_image
+ (Buf : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ D, L : in Interfaces.C.int);
+ pragma Import (C, fl_draw_draw_image, "fl_draw_draw_image");
+ pragma Inline (fl_draw_draw_image);
+
+ procedure fl_draw_draw_image2
+ (Call, User : in Storage.Integer_Address;
+ X, Y, W, H, D : in Interfaces.C.int);
+ pragma Import (C, fl_draw_draw_image2, "fl_draw_draw_image2");
+ pragma Inline (fl_draw_draw_image2);
+
+ procedure fl_draw_draw_image_mono
+ (Buf : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ D, L : in Interfaces.C.int);
+ pragma Import (C, fl_draw_draw_image_mono, "fl_draw_draw_image_mono");
+ pragma Inline (fl_draw_draw_image_mono);
+
+ procedure fl_draw_draw_image_mono2
+ (Call, User : in Storage.Integer_Address;
+ X, Y, W, H, D : in Interfaces.C.int);
+ pragma Import (C, fl_draw_draw_image_mono2, "fl_draw_draw_image_mono2");
+ pragma Inline (fl_draw_draw_image_mono2);
+
+ function fl_draw_read_image
+ (Buf : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ Alpha : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_draw_read_image, "fl_draw_read_image");
+ pragma Inline (fl_draw_read_image);
+
+
+
+
+ function fl_draw_add_symbol
+ (Name : in Interfaces.C.char_array;
+ Drawit : in Storage.Integer_Address;
+ Scalable : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_draw_add_symbol, "fl_draw_add_symbol");
+ pragma Inline (fl_draw_add_symbol);
+
+ procedure fl_draw_draw_text
+ (Str : in Interfaces.C.char_array;
+ N, X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_draw_draw_text, "fl_draw_draw_text");
+ pragma Inline (fl_draw_draw_text);
+
+ procedure fl_draw_draw_text2
+ (Str : in Interfaces.C.char_array;
+ X, Y, W, H : in Interfaces.C.int;
+ Ali : in Interfaces.Unsigned_16;
+ Img : in Storage.Integer_Address;
+ Sym : in Interfaces.C.int);
+ pragma Import (C, fl_draw_draw_text2, "fl_draw_draw_text2");
+ pragma Inline (fl_draw_draw_text2);
+
+ procedure fl_draw_draw_text3
+ (Str : in Interfaces.C.char_array;
+ X, Y, W, H : in Interfaces.C.int;
+ Ali : in Interfaces.Unsigned_16;
+ Func : in Storage.Integer_Address;
+ Img : in Storage.Integer_Address;
+ Sym : in Interfaces.C.int);
+ pragma Import (C, fl_draw_draw_text3, "fl_draw_draw_text3");
+ pragma Inline (fl_draw_draw_text3);
+
+ procedure fl_draw_draw_text4
+ (Ang : in Interfaces.C.int;
+ Str : in Interfaces.C.char_array;
+ N, X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_draw_draw_text4, "fl_draw_draw_text4");
+ pragma Inline (fl_draw_draw_text4);
+
+ procedure fl_draw_rtl_draw
+ (Str : in Interfaces.C.char_array;
+ N, X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_draw_rtl_draw, "fl_draw_rtl_draw");
+ pragma Inline (fl_draw_rtl_draw);
+
+ procedure fl_draw_draw_box
+ (BK : in Interfaces.C.int;
+ X, Y, W, H : in Interfaces.C.int;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_draw_draw_box, "fl_draw_draw_box");
+ pragma Inline (fl_draw_draw_box);
+
+ function fl_draw_draw_symbol
+ (Lab : in Interfaces.C.char_array;
+ X, Y, W, H : in Interfaces.C.int;
+ Hue : in Interfaces.C.unsigned)
+ return Interfaces.C.int;
+ pragma Import (C, fl_draw_draw_symbol, "fl_draw_draw_symbol");
+ pragma Inline (fl_draw_draw_symbol);
+
+ procedure fl_draw_measure
+ (Str : in Interfaces.C.char_array;
+ W, H : in out Interfaces.C.int;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_draw_measure, "fl_draw_measure");
+ pragma Inline (fl_draw_measure);
+
+ procedure fl_draw_scroll
+ (X, Y, W, H : in Interfaces.C.int;
+ DX, DY : in Interfaces.C.int;
+ Func, Data : in Storage.Integer_Address);
+ pragma Import (C, fl_draw_scroll, "fl_draw_scroll");
+ pragma Inline (fl_draw_scroll);
+
+ procedure fl_draw_text_extents
+ (Str : in Interfaces.C.char_array;
+ N : in Interfaces.C.int;
+ DX, DY, W, H : out Interfaces.C.int);
+ pragma Import (C, fl_draw_text_extents, "fl_draw_text_extents");
+ pragma Inline (fl_draw_text_extents);
+
+ function fl_draw_width
+ (Str : in Interfaces.C.char_array;
+ N : in Interfaces.C.int)
+ return Interfaces.C.double;
+ pragma Import (C, fl_draw_width, "fl_draw_width");
+ pragma Inline (fl_draw_width);
+
+ function fl_draw_width2
+ (C : in Interfaces.C.unsigned_long)
+ return Interfaces.C.double;
+ pragma Import (C, fl_draw_width2, "fl_draw_width2");
+ pragma Inline (fl_draw_width2);
+
+
+
+
+ procedure fl_draw_begin_complex_polygon;
+ pragma Import (C, fl_draw_begin_complex_polygon, "fl_draw_begin_complex_polygon");
+ pragma Inline (fl_draw_begin_complex_polygon);
+
+ procedure fl_draw_begin_line;
+ pragma Import (C, fl_draw_begin_line, "fl_draw_begin_line");
+ pragma Inline (fl_draw_begin_line);
+
+ procedure fl_draw_begin_loop;
+ pragma Import (C, fl_draw_begin_loop, "fl_draw_begin_loop");
+ pragma Inline (fl_draw_begin_loop);
+
+ procedure fl_draw_begin_points;
+ pragma Import (C, fl_draw_begin_points, "fl_draw_begin_points");
+ pragma Inline (fl_draw_begin_points);
+
+ procedure fl_draw_begin_polygon;
+ pragma Import (C, fl_draw_begin_polygon, "fl_draw_begin_polygon");
+ pragma Inline (fl_draw_begin_polygon);
+
+
+
+
+ procedure fl_draw_arc
+ (X, Y, R, Start, Finish : in Interfaces.C.double);
+ pragma Import (C, fl_draw_arc, "fl_draw_arc");
+ pragma Inline (fl_draw_arc);
+
+ procedure fl_draw_arc2
+ (X, Y, W, H : in Interfaces.C.int;
+ A1, A2 : in Interfaces.C.double);
+ pragma Import (C, fl_draw_arc2, "fl_draw_arc2");
+ pragma Inline (fl_draw_arc2);
+
+ -- this function does not yet exist
+ -- procedure fl_draw_chord
+ -- (X, Y, W, H : in Interfaces.C.int;
+ -- A1, A2 : in Interfaces.C.double);
+ -- pragma Import (C, fl_draw_chord, "fl_draw_chord");
+ -- pragma Inline (fl_draw_chord);
+
+ procedure fl_draw_circle
+ (X, Y, R : in Interfaces.C.double);
+ pragma Import (C, fl_draw_circle, "fl_draw_circle");
+ pragma Inline (fl_draw_circle);
+
+ procedure fl_draw_curve
+ (X0, Y0 : in Interfaces.C.double;
+ X1, Y1 : in Interfaces.C.double;
+ X2, Y2 : in Interfaces.C.double;
+ X3, Y3 : in Interfaces.C.double);
+ pragma Import (C, fl_draw_curve, "fl_draw_curve");
+ pragma Inline (fl_draw_curve);
+
+ procedure fl_draw_frame
+ (S : in Interfaces.C.char_array;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_draw_frame, "fl_draw_frame");
+ pragma Inline (fl_draw_frame);
+
+ procedure fl_draw_gap;
+ pragma Import (C, fl_draw_gap, "fl_draw_gap");
+ pragma Inline (fl_draw_gap);
+
+ procedure fl_draw_line
+ (X0, Y0 : in Interfaces.C.int;
+ X1, Y1 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_line, "fl_draw_line");
+ pragma Inline (fl_draw_line);
+
+ procedure fl_draw_line2
+ (X0, Y0 : in Interfaces.C.int;
+ X1, Y1 : in Interfaces.C.int;
+ X2, Y2 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_line2, "fl_draw_line2");
+ pragma Inline (fl_draw_line2);
+
+ procedure fl_draw_loop
+ (X0, Y0 : in Interfaces.C.int;
+ X1, Y1 : in Interfaces.C.int;
+ X2, Y2 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_loop, "fl_draw_loop");
+ pragma Inline (fl_draw_loop);
+
+ procedure fl_draw_loop2
+ (X0, Y0 : in Interfaces.C.int;
+ X1, Y1 : in Interfaces.C.int;
+ X2, Y2 : in Interfaces.C.int;
+ X3, Y3 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_loop2, "fl_draw_loop2");
+ pragma Inline (fl_draw_loop2);
+
+ procedure fl_draw_pie
+ (X, Y, W, H : in Interfaces.C.int;
+ A1, A2 : in Interfaces.C.double);
+ pragma Import (C, fl_draw_pie, "fl_draw_pie");
+ pragma Inline (fl_draw_pie);
+
+ procedure fl_draw_point
+ (X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_draw_point, "fl_draw_point");
+ pragma Inline (fl_draw_point);
+
+ procedure fl_draw_polygon
+ (X0, Y0 : in Interfaces.C.int;
+ X1, Y1 : in Interfaces.C.int;
+ X2, Y2 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_polygon, "fl_draw_polygon");
+ pragma Inline (fl_draw_polygon);
+
+ procedure fl_draw_polygon2
+ (X0, Y0 : in Interfaces.C.int;
+ X1, Y1 : in Interfaces.C.int;
+ X2, Y2 : in Interfaces.C.int;
+ X3, Y3 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_polygon2, "fl_draw_polygon2");
+ pragma Inline (fl_draw_polygon2);
+
+ procedure fl_draw_rect
+ (X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_draw_rect, "fl_draw_rect");
+ pragma Inline (fl_draw_rect);
+
+ procedure fl_draw_rect2
+ (X, Y, W, H : in Interfaces.C.int;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_draw_rect2, "fl_draw_rect2");
+ pragma Inline (fl_draw_rect2);
+
+ procedure fl_draw_rect_fill
+ (X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_draw_rect_fill, "fl_draw_rect_fill");
+ pragma Inline (fl_draw_rect_fill);
+
+ procedure fl_draw_rect_fill2
+ (X, Y, W, H : in Interfaces.C.int;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_draw_rect_fill2, "fl_draw_rect_fill2");
+ pragma Inline (fl_draw_rect_fill2);
+
+ procedure fl_draw_rect_fill3
+ (X, Y, W, H : in Interfaces.C.int;
+ R, G, B : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_draw_rect_fill3, "fl_draw_rect_fill3");
+ pragma Inline (fl_draw_rect_fill3);
+
+ procedure fl_draw_xy_line
+ (X0, Y0, X1 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_xy_line, "fl_draw_xy_line");
+ pragma Inline (fl_draw_xy_line);
+
+ procedure fl_draw_xy_line2
+ (X0, Y0, X1, Y2 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_xy_line2, "fl_draw_xy_line2");
+ pragma Inline (fl_draw_xy_line2);
+
+ procedure fl_draw_xy_line3
+ (X0, Y0, X1, Y2, X3 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_xy_line3, "fl_draw_xy_line3");
+ pragma Inline (fl_draw_xy_line3);
+
+ procedure fl_draw_yx_line
+ (X0, Y0, Y1 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_yx_line, "fl_draw_yx_line");
+ pragma Inline (fl_draw_yx_line);
+
+ procedure fl_draw_yx_line2
+ (X0, Y0, Y1, X2 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_yx_line2, "fl_draw_yx_line2");
+ pragma Inline (fl_draw_yx_line2);
+
+ procedure fl_draw_yx_line3
+ (X0, Y0, Y1, X2, Y3 : in Interfaces.C.int);
+ pragma Import (C, fl_draw_yx_line3, "fl_draw_yx_line3");
+ pragma Inline (fl_draw_yx_line3);
+
+
+
+
+ procedure fl_draw_end_complex_polygon;
+ pragma Import (C, fl_draw_end_complex_polygon, "fl_draw_end_complex_polygon");
+ pragma Inline (fl_draw_end_complex_polygon);
+
+ procedure fl_draw_end_line;
+ pragma Import (C, fl_draw_end_line, "fl_draw_end_line");
+ pragma Inline (fl_draw_end_line);
+
+ procedure fl_draw_end_loop;
+ pragma Import (C, fl_draw_end_loop, "fl_draw_end_loop");
+ pragma Inline (fl_draw_end_loop);
+
+ procedure fl_draw_end_points;
+ pragma Import (C, fl_draw_end_points, "fl_draw_end_points");
+ pragma Inline (fl_draw_end_points);
+
+ procedure fl_draw_end_polygon;
+ pragma Import (C, fl_draw_end_polygon, "fl_draw_end_polygon");
+ pragma Inline (fl_draw_end_polygon);
+
+
+
+
+ ------------------------
+ -- No Documentation --
+ ------------------------
+
+ procedure Reset_Spot is
+ begin
+ fl_draw_reset_spot;
+ end Reset_Spot;
+
+
+ procedure Set_Spot
+ (X, Y, W, H : in Integer;
+ Font : in Font_Kind;
+ Size : in Font_Size) is
+ begin
+ fl_draw_set_spot
+ (Font_Kind'Pos (Font),
+ Interfaces.C.int (Size),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Null_Pointer);
+ end Set_Spot;
+
+
+ procedure Set_Spot
+ (X, Y, W, H : in Integer;
+ Font : in Font_Kind;
+ Size : in Font_Size;
+ Pane : in FLTK.Widgets.Groups.Windows.Window'Class) is
+ begin
+ fl_draw_set_spot
+ (Font_Kind'Pos (Font),
+ Interfaces.C.int (Size),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Wrapper (Pane).Void_Ptr);
+ end Set_Spot;
+
+
+ procedure Set_Status
+ (X, Y, W, H : in Integer) is
+ begin
+ fl_draw_set_status
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Set_Status;
+
+
+
+
+ ---------------
+ -- Utility --
+ ---------------
+
+ function Can_Do_Alpha_Blending
+ return Boolean
+ is
+ Result : Interfaces.C.int := fl_draw_can_do_alpha_blending;
+ begin
+ if Result = 1 then
+ return True;
+ else
+ pragma Assert (Result = 0);
+ return False;
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Can_Do_Alpha_Blending;
+
+
+ function Shortcut_Label
+ (Keys : in Key_Combo)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value
+ (fl_draw_shortcut_label (Interfaces.C.unsigned (To_C (Keys))));
+ end Shortcut_Label;
+
+
+
+
+ --------------------------
+ -- Charset Conversion --
+ --------------------------
+
+ function Latin1_To_Local
+ (From : in String)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value
+ (fl_draw_latin1_to_local (Interfaces.C.To_C (From), -1));
+ end Latin1_To_Local;
+
+
+ function Local_To_Latin1
+ (From : in String)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value
+ (fl_draw_local_to_latin1 (Interfaces.C.To_C (From), -1));
+ end Local_To_Latin1;
+
+
+ function Mac_Roman_To_Local
+ (From : in String)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value
+ (fl_draw_mac_roman_to_local (Interfaces.C.To_C (From), -1));
+ end Mac_Roman_To_Local;
+
+
+ function Local_To_Mac_Roman
+ (From : in String)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value
+ (fl_draw_local_to_mac_roman (Interfaces.C.To_C (From), -1));
+ end Local_To_Mac_Roman;
+
+
+
+
+ ----------------
+ -- Clipping --
+ ----------------
+
+ function Clip_Box
+ (X, Y, W, H : in Integer;
+ BX, BY, BW, BH : out Integer)
+ return Boolean
+ is
+ CX, CY, CW, CH : Interfaces.C.int;
+ Result : Interfaces.C.int := fl_draw_clip_box
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ CX, CY, CW, CH);
+ begin
+ BX := Integer (CX);
+ BY := Integer (CY);
+ BW := Integer (CW);
+ BH := Integer (CH);
+ return Result /= 0;
+ end Clip_Box;
+
+
+ function Clip_Intersects
+ (X, Y, W, H : in Integer)
+ return Boolean is
+ begin
+ return fl_draw_not_clipped
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H)) /= 0;
+ end Clip_Intersects;
+
+
+ procedure Pop_Clip is
+ begin
+ fl_draw_pop_clip;
+ end Pop_Clip;
+
+
+ procedure Push_Clip
+ (X, Y, W, H : in Integer) is
+ begin
+ fl_draw_push_clip
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Push_Clip;
+
+
+ procedure Push_No_Clip is
+ begin
+ fl_draw_push_no_clip;
+ end Push_No_Clip;
+
+
+ procedure Restore_Clip is
+ begin
+ fl_draw_restore_clip;
+ end Restore_Clip;
+
+
+
+
+ ---------------
+ -- Overlay --
+ ---------------
+
+ procedure Overlay_Clear is
+ begin
+ fl_draw_overlay_clear;
+ end Overlay_Clear;
+
+
+ procedure Overlay_Rect
+ (X, Y, W, H : in Integer) is
+ begin
+ fl_draw_overlay_rect
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Overlay_Rect;
+
+
+
+
+ ----------------
+ -- Settings --
+ ----------------
+
+ function Get_Color
+ return Color is
+ begin
+ return Color (fl_draw_get_color);
+ end Get_Color;
+
+
+ procedure Set_Color
+ (To : in Color) is
+ begin
+ fl_draw_set_color (Interfaces.C.unsigned (To));
+ end Set_Color;
+
+
+ procedure Set_Color
+ (R, G, B : in Color_Component) is
+ begin
+ fl_draw_set_color2
+ (Interfaces.C.unsigned_char (R),
+ Interfaces.C.unsigned_char (G),
+ Interfaces.C.unsigned_char (B));
+ end Set_Color;
+
+
+ procedure Set_Cursor
+ (To : in Mouse_Cursor_Kind) is
+ begin
+ fl_draw_set_cursor (Cursor_Values (To));
+ end Set_Cursor;
+
+ procedure Set_Cursor
+ (To : in Mouse_Cursor_Kind;
+ Fore : in Color;
+ Back : in Color := White_Color) is
+ begin
+ fl_draw_set_cursor2
+ (Cursor_Values (To),
+ Interfaces.C.unsigned (Fore),
+ Interfaces.C.unsigned (Back));
+ end Set_Cursor;
+
+
+ function Get_Font
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_draw_get_font);
+ end Get_Font;
+
+
+ function Get_Font_Size
+ return Font_Size is
+ begin
+ return Font_Size (fl_draw_size);
+ end Get_Font_Size;
+
+
+ procedure Set_Font
+ (Kind : in Font_Kind;
+ Size : in Font_Size) is
+ begin
+ fl_draw_set_font (Font_Kind'Pos (Kind), Interfaces.C.int (Size));
+ end Set_Font;
+
+
+ function Font_Line_Spacing
+ return Integer is
+ begin
+ return Integer (fl_draw_height);
+ end Font_Line_Spacing;
+
+
+ function Font_Descent
+ return Integer is
+ begin
+ return Integer (fl_draw_descent);
+ end Font_Descent;
+
+
+ function Font_Height
+ (Kind : in Font_Kind;
+ Size : in Font_Size)
+ return Natural is
+ begin
+ return Natural (fl_draw_height2 (Font_Kind'Pos (Kind), Interfaces.C.int (Size)));
+ end Font_Height;
+
+
+ type Char_Array_Access is access Interfaces.C.char_array;
+
+ procedure Free_Char_Array is new Ada.Unchecked_Deallocation
+ (Object => Interfaces.C.char_array,
+ Name => Char_Array_Access);
+
+ Current_Dashes : Char_Array_Access;
+
+ procedure Set_Line_Style
+ (Line : in Line_Kind := Solid_Line;
+ Cap : in Cap_Kind := Default_Cap;
+ Join : in Join_Kind := Default_Join;
+ Width : in Natural := 0;
+ Dashes : in Dash_Gap_Array := Empty_Dashes) is
+ begin
+ Free_Char_Array (Current_Dashes);
+ Current_Dashes := new Interfaces.C.char_array (1 .. (Dashes'Length + 1) * 2);
+ for Index in Integer range 1 .. Dashes'Length loop
+ Current_Dashes (2 * Interfaces.C.size_t (Index) - 1) :=
+ Interfaces.C.char'Val (Integer (Dashes (Index).Solid));
+ Current_Dashes (2 * Interfaces.C.size_t (Index)) :=
+ Interfaces.C.char'Val (Integer (Dashes (Index).Blank));
+ end loop;
+ Current_Dashes (Current_Dashes'Last - 1) := Interfaces.C.char'Val (0);
+ Current_Dashes (Current_Dashes'Last) := Interfaces.C.char'Val (0);
+ fl_draw_line_style
+ (Line_Kind'Pos (Line) + Cap_Kind'Pos (Cap) * 16#100# + Join_Kind'Pos (Join) * 16#1000#,
+ Interfaces.C.int (Width),
+ Current_Dashes.all);
+ end Set_Line_Style;
+
+
+
+
+ -------------------------
+ -- Matrix Operations --
+ -------------------------
+
+ procedure Mult_Matrix
+ (A, B, C, D, X, Y : in Long_Float) is
+ begin
+ fl_draw_mult_matrix
+ (Interfaces.C.double (A),
+ Interfaces.C.double (B),
+ Interfaces.C.double (C),
+ Interfaces.C.double (D),
+ Interfaces.C.double (X),
+ Interfaces.C.double (Y));
+ end Mult_Matrix;
+
+
+ procedure Pop_Matrix is
+ begin
+ fl_draw_pop_matrix;
+ end Pop_Matrix;
+
+
+ procedure Push_Matrix is
+ begin
+ fl_draw_push_matrix;
+ end Push_Matrix;
+
+
+ procedure Rotate
+ (Angle : in Long_Float) is
+ begin
+ fl_draw_rotate (Interfaces.C.double (Angle));
+ end Rotate;
+
+
+ procedure Scale
+ (Factor : in Long_Float) is
+ begin
+ fl_draw_scale (Interfaces.C.double (Factor));
+ end Scale;
+
+
+ procedure Scale
+ (Factor_X, Factor_Y : in Long_Float) is
+ begin
+ fl_draw_scale2
+ (Interfaces.C.double (Factor_X),
+ Interfaces.C.double (Factor_Y));
+ end Scale;
+
+
+ function Transform_DX
+ (X, Y : in Long_Float)
+ return Long_Float is
+ begin
+ return Long_Float (fl_draw_transform_dx
+ (Interfaces.C.double (X),
+ Interfaces.C.double (Y)));
+ end Transform_DX;
+
+
+ function Transform_DY
+ (X, Y : in Long_Float)
+ return Long_Float is
+ begin
+ return Long_Float (fl_draw_transform_dy
+ (Interfaces.C.double (X),
+ Interfaces.C.double (Y)));
+ end Transform_DY;
+
+
+ function Transform_X
+ (X, Y : in Long_Float)
+ return Long_Float is
+ begin
+ return Long_Float (fl_draw_transform_x
+ (Interfaces.C.double (X),
+ Interfaces.C.double (Y)));
+ end Transform_X;
+
+
+ function Transform_Y
+ (X, Y : in Long_Float)
+ return Long_Float is
+ begin
+ return Long_Float (fl_draw_transform_y
+ (Interfaces.C.double (X),
+ Interfaces.C.double (Y)));
+ end Transform_Y;
+
+
+ procedure Transformed_Vertex
+ (XF, YF : in Long_Float) is
+ begin
+ fl_draw_transformed_vertex
+ (Interfaces.C.double (XF),
+ Interfaces.C.double (YF));
+ end Transformed_Vertex;
+
+
+ procedure Translate
+ (X, Y : in Long_Float) is
+ begin
+ fl_draw_translate
+ (Interfaces.C.double (X),
+ Interfaces.C.double (Y));
+ end Translate;
+
+
+ procedure Vertex
+ (X, Y : in Long_Float) is
+ begin
+ fl_draw_vertex
+ (Interfaces.C.double (X),
+ Interfaces.C.double (Y));
+ end Vertex;
+
+
+
+
+ ---------------------
+ -- Image Drawing --
+ ---------------------
+
+ procedure Draw_Image
+ (X, Y, W, H : in Integer;
+ Data : in Color_Component_Array;
+ Depth : in Positive := 3;
+ Line_Data : in Natural := 0;
+ Flip_Horizontal : in Boolean := False;
+ Flip_Vertical : in Boolean := False)
+ is
+ Real_Depth : Integer := Depth;
+ Real_Line_Data : Integer := Line_Data;
+ begin
+ if Flip_Horizontal then
+ Real_Depth := Real_Depth * (-1);
+ end if;
+ if Flip_Vertical then
+ if Real_Line_Data = 0 then
+ Real_Line_Data := W * Depth * (-1);
+ else
+ Real_Line_Data := Real_Line_Data * (-1);
+ end if;
+ end if;
+ fl_draw_draw_image
+ (Storage.To_Integer (Data (Data'First)'Address),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Real_Depth),
+ Interfaces.C.int (Real_Line_Data));
+ end Draw_Image;
+
+
+ Image_Func_Ptr : Image_Draw_Function;
+
+ procedure Draw_Image_Hook
+ (User : in Storage.Integer_Address;
+ X, Y, W : in Interfaces.C.int;
+ Buf_Ptr : in Storage.Integer_Address)
+ is
+ Data_Buffer : Color_Component_Array (1 .. Integer (W));
+ for Data_Buffer'Address use Storage.To_Address (Buf_Ptr);
+ pragma Import (Ada, Data_Buffer);
+ begin
+ Image_Func_Ptr (Integer (X), Integer (Y), Data_Buffer);
+ end Draw_Image_Hook;
+
+ procedure Draw_Image
+ (X, Y, W, H : in Integer;
+ Callback : in Image_Draw_Function;
+ Depth : in Positive := 3) is
+ begin
+ Image_Func_Ptr := Callback;
+ fl_draw_draw_image2
+ (Storage.To_Integer (Draw_Image_Hook'Address),
+ Null_Pointer,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Depth));
+ end Draw_Image;
+
+
+ procedure Draw_Image_Mono
+ (X, Y, W, H : in Integer;
+ Data : in Color_Component_Array;
+ Depth : in Positive := 1;
+ Line_Data : in Natural := 0;
+ Flip_Horizontal : Boolean := False;
+ Flip_Vertical : Boolean := False)
+ is
+ Real_Depth : Integer := Depth;
+ Real_Line_Data : Integer := Line_Data;
+ begin
+ if Flip_Horizontal then
+ Real_Depth := Real_Depth * (-1);
+ end if;
+ if Flip_Vertical then
+ if Real_Line_Data = 0 then
+ Real_Line_Data := W * Depth * (-1);
+ else
+ Real_Line_Data := Real_Line_Data * (-1);
+ end if;
+ end if;
+ fl_draw_draw_image_mono
+ (Storage.To_Integer (Data (Data'First)'Address),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Real_Depth),
+ Interfaces.C.int (Real_Line_Data));
+ end Draw_Image_Mono;
+
+
+ Mono_Image_Func_Ptr : Image_Draw_Function;
+
+ procedure Draw_Image_Mono_Hook
+ (User : in Storage.Integer_Address;
+ X, Y, W : in Interfaces.C.int;
+ Buf_Ptr : in Storage.Integer_Address)
+ is
+ Data_Buffer : Color_Component_Array (1 .. Integer (W));
+ for Data_Buffer'Address use Storage.To_Address (Buf_Ptr);
+ pragma Import (Ada, Data_Buffer);
+ begin
+ Mono_Image_Func_Ptr (Integer (X), Integer (Y), Data_Buffer);
+ end Draw_Image_Mono_Hook;
+
+ procedure Draw_Image_Mono
+ (X, Y, W, H : in Integer;
+ Callback : in Image_Draw_Function;
+ Depth : in Positive := 1) is
+ begin
+ Mono_Image_Func_Ptr := Callback;
+ fl_draw_draw_image_mono2
+ (Storage.To_Integer (Draw_Image_Mono_Hook'Address),
+ Null_Pointer,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Depth));
+ end Draw_Image_Mono;
+
+
+ function Read_Image
+ (X, Y, W, H : in Integer;
+ Alpha : in Integer := 0)
+ return Color_Component_Array
+ is
+ My_Len : Integer := (if Alpha = 0 then W * H * 3 else W * H * 4);
+ Result : Color_Component_Array (1 .. My_Len);
+ Buffer : Storage.Integer_Address;
+ begin
+ Buffer := fl_draw_read_image
+ (Storage.To_Integer (Result (Result'First)'Address),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Alpha));
+ pragma Assert (Buffer = Storage.To_Integer (Result (Result'First)'Address));
+ return Result;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Read_Image;
+
+
+
+
+ -----------------------
+ -- Special Drawing --
+ -----------------------
+
+ procedure Add_Symbol
+ (Text : in String;
+ Callback : in Symbol_Draw_Function;
+ Scalable : in Boolean)
+ is
+ Ret_Val : Interfaces.C.int := fl_draw_add_symbol
+ (Interfaces.C.To_C (Text),
+ Storage.To_Integer (Callback.all'Address),
+ Boolean'Pos (Scalable));
+ begin
+ if Ret_Val = 0 then
+ raise Draw_Error;
+ else
+ pragma Assert (Ret_Val = 1);
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Add_Symbol;
+
+ procedure Draw_Text
+ (X, Y : in Integer;
+ Text : in String) is
+ begin
+ fl_draw_draw_text
+ (Interfaces.C.To_C (Text),
+ Text'Length,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Draw_Text;
+
+
+ procedure Draw_Text
+ (X, Y, W, H : in Integer;
+ Text : in String;
+ Align : in Alignment;
+ Symbols : in Boolean := True) is
+ begin
+ fl_draw_draw_text2
+ (Interfaces.C.To_C (Text),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.Unsigned_16 (Align),
+ Null_Pointer,
+ Boolean'Pos (Symbols));
+ end Draw_Text;
+
+
+ procedure Draw_Text
+ (X, Y, W, H : in Integer;
+ Text : in String;
+ Align : in Alignment;
+ Picture : in FLTK.Images.Image'Class;
+ Symbols : in Boolean := True) is
+ begin
+ fl_draw_draw_text2
+ (Interfaces.C.To_C (Text),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.Unsigned_16 (Align),
+ Wrapper (Picture).Void_Ptr,
+ Boolean'Pos (Symbols));
+ end Draw_Text;
+
+
+ Text_Func_Ptr : Text_Draw_Function;
+
+ procedure Draw_Text_Hook
+ (Ptr : in Storage.Integer_Address;
+ N, X0, Y0 : in Interfaces.C.int)
+ is
+ Data : String (1 .. Integer (N));
+ for Data'Address use Storage.To_Address (Ptr);
+ pragma Import (Ada, Data);
+ begin
+ Text_Func_Ptr (Integer (X0), Integer (Y0), Data);
+ end Draw_Text_Hook;
+
+
+ procedure Draw_Text
+ (X, Y, W, H : in Integer;
+ Text : in String;
+ Align : in Alignment;
+ Callback : in Text_Draw_Function;
+ Symbols : in Boolean := True) is
+ begin
+ Text_Func_Ptr := Callback;
+ fl_draw_draw_text3
+ (Interfaces.C.To_C (Text),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.Unsigned_16 (Align),
+ Storage.To_Integer (Draw_Text_Hook'Address),
+ Null_Pointer,
+ Boolean'Pos (Symbols));
+ end Draw_Text;
+
+
+ procedure Draw_Text
+ (X, Y, W, H : in Integer;
+ Text : in String;
+ Align : in Alignment;
+ Callback : in Text_Draw_Function;
+ Picture : in FLTK.Images.Image'Class;
+ Symbols : in Boolean := True) is
+ begin
+ Text_Func_Ptr := Callback;
+ fl_draw_draw_text3
+ (Interfaces.C.To_C (Text),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.Unsigned_16 (Align),
+ Storage.To_Integer (Draw_Text_Hook'Address),
+ Wrapper (Picture).Void_Ptr,
+ Boolean'Pos (Symbols));
+ end Draw_Text;
+
+
+ procedure Draw_Text
+ (X, Y : in Integer;
+ Text : in String;
+ Angle : in Integer) is
+ begin
+ fl_draw_draw_text4
+ (Interfaces.C.int (Angle),
+ Interfaces.C.To_C (Text),
+ Text'Length,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Draw_Text;
+
+
+ procedure Draw_Text_Right_Left
+ (X, Y : in Integer;
+ Text : in String) is
+ begin
+ fl_draw_rtl_draw
+ (Interfaces.C.To_C (Text),
+ Text'Length,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Draw_Text_Right_Left;
+
+
+ procedure Draw_Box
+ (X, Y, W, H : in Integer;
+ Kind : in Box_Kind;
+ Hue : in Color) is
+ begin
+ fl_draw_draw_box
+ (Box_Kind'Pos (Kind),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.unsigned (Hue));
+ end Draw_Box;
+
+
+ procedure Draw_Symbol
+ (X, Y, W, H : in Integer;
+ Name : in String;
+ Hue : in Color)
+ is
+ Ret_Val : Interfaces.C.int := fl_draw_draw_symbol
+ (Interfaces.C.To_C (Name),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.unsigned (Hue));
+ begin
+ if Ret_Val = 0 then
+ raise Draw_Error;
+ else
+ pragma Assert (Ret_Val = 1);
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Draw_Symbol;
+
+
+ procedure Measure
+ (Text : in String;
+ W, H : out Natural;
+ Symbols : in Boolean := True;
+ Wrap : in Natural := 0)
+ is
+ Result_W : Interfaces.C.int := Interfaces.C.int (Wrap);
+ Result_H : Interfaces.C.int := 0;
+ begin
+ fl_draw_measure
+ (Interfaces.C.To_C (Text),
+ Result_W, Result_H,
+ Boolean'Pos (Symbols));
+ W := Natural (Result_W);
+ H := Natural (Result_H);
+ end Measure;
+
+
+ procedure Scroll_Hook
+ (Ptr : in Area_Draw_Function;
+ X, Y, W, H : in Interfaces.C.int) is
+ begin
+ Ptr.all (Integer (X), Integer (Y), Integer (W), Integer (H));
+ end Scroll_Hook;
+
+
+ procedure Scroll
+ (X, Y, W, H : in Integer;
+ DX, DY : in Integer;
+ Callback : in Area_Draw_Function) is
+ begin
+ fl_draw_scroll
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (DX),
+ Interfaces.C.int (DY),
+ Storage.To_Integer (Scroll_Hook'Address),
+ Storage.To_Integer (Callback.all'Address));
+ end Scroll;
+
+
+ procedure Text_Extents
+ (Text : in String;
+ DX, DY, W, H : out Integer)
+ is
+ Result_DX, Result_DY, Result_W, Result_H : Interfaces.C.int;
+ begin
+ fl_draw_text_extents
+ (Interfaces.C.To_C (Text),
+ Text'Length,
+ Result_DX,
+ Result_DY,
+ Result_W,
+ Result_H);
+ DX := Integer (Result_DX);
+ DY := Integer (Result_DY);
+ W := Integer (Result_W);
+ H := Integer (Result_H);
+ end Text_Extents;
+
+
+ function Width
+ (Text : in String)
+ return Long_Float is
+ begin
+ return Long_Float (fl_draw_width (Interfaces.C.To_C (Text), Text'Length));
+ end Width;
+
+
+ function Width
+ (Glyph : in Character)
+ return Long_Float is
+ begin
+ return Long_Float (fl_draw_width2 (Character'Pos (Glyph)));
+ end Width;
+
+
+ function Width
+ (Glyph : in Wide_Character)
+ return Long_Float is
+ begin
+ return Long_Float (fl_draw_width2 (Wide_Character'Pos (Glyph)));
+ end Width;
+
+
+ function Width
+ (Glyph : in Wide_Wide_Character)
+ return Long_Float is
+ begin
+ return Long_Float (fl_draw_width2 (Wide_Wide_Character'Pos (Glyph)));
+ end Width;
+
+
+
+
+ ----------------------
+ -- Manual Drawing --
+ ----------------------
+
+ procedure Begin_Complex_Polygon is
+ begin
+ fl_draw_begin_complex_polygon;
+ end Begin_Complex_Polygon;
+
+ procedure Begin_Line is
+ begin
+ fl_draw_begin_line;
+ end Begin_Line;
+
+ procedure Begin_Loop is
+ begin
+ fl_draw_begin_loop;
+ end Begin_Loop;
+
+ procedure Begin_Points is
+ begin
+ fl_draw_begin_points;
+ end Begin_Points;
+
+ procedure Begin_Polygon is
+ begin
+ fl_draw_begin_polygon;
+ end Begin_Polygon;
+
+
+ procedure Arc
+ (X, Y, R, Start, Finish : in Long_Float) is
+ begin
+ fl_draw_arc
+ (Interfaces.C.double (X),
+ Interfaces.C.double (Y),
+ Interfaces.C.double (R),
+ Interfaces.C.double (Start),
+ Interfaces.C.double (Finish));
+ end Arc;
+
+
+ procedure Arc
+ (X, Y, W, H : in Integer;
+ Start, Finish : in Long_Float) is
+ begin
+ fl_draw_arc2
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.double (Start),
+ Interfaces.C.double (Finish));
+ end Arc;
+
+
+ procedure Chord
+ (X, Y, W, H : in Integer;
+ Angle1, Angle2 : in Long_Float) is
+ begin
+ null;
+ -- this function does not yet exist
+ -- fl_draw_chord
+ -- (Interfaces.C.int (X),
+ -- Interfaces.C.int (Y),
+ -- Interfaces.C.int (W),
+ -- Interfaces.C.int (H),
+ -- Interfaces.C.double (Angle1),
+ -- Interfaces.C.double (Angle2));
+ end Chord;
+
+
+ procedure Circle
+ (X, Y, R : in Long_Float) is
+ begin
+ fl_draw_circle
+ (Interfaces.C.double (X),
+ Interfaces.C.double (Y),
+ Interfaces.C.double (R));
+ end Circle;
+
+
+ procedure Curve
+ (X0, Y0 : in Long_Float;
+ X1, Y1 : in Long_Float;
+ X2, Y2 : in Long_Float;
+ X3, Y3 : in Long_Float) is
+ begin
+ fl_draw_curve
+ (Interfaces.C.double (X0), Interfaces.C.double (Y0),
+ Interfaces.C.double (X1), Interfaces.C.double (Y1),
+ Interfaces.C.double (X2), Interfaces.C.double (Y2),
+ Interfaces.C.double (X3), Interfaces.C.double (Y3));
+ end Curve;
+
+
+ procedure Frame
+ (X, Y, W, H : in Integer;
+ Top, Left, Bottom, Right : in Greyscale) is
+ begin
+ fl_draw_frame
+ (Interfaces.C.To_C
+ (Character (Top) & Character (Left) & Character (Bottom) & Character (Right)),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Frame;
+
+
+ procedure Gap is
+ begin
+ fl_draw_gap;
+ end Gap;
+
+
+ procedure Line
+ (X0, Y0 : in Integer;
+ X1, Y1 : in Integer) is
+ begin
+ fl_draw_line
+ (Interfaces.C.int (X0), Interfaces.C.int (Y0),
+ Interfaces.C.int (X1), Interfaces.C.int (Y1));
+ end Line;
+
+
+ procedure Line
+ (X0, Y0 : in Integer;
+ X1, Y1 : in Integer;
+ X2, Y2 : in Integer) is
+ begin
+ fl_draw_line2
+ (Interfaces.C.int (X0), Interfaces.C.int (Y0),
+ Interfaces.C.int (X1), Interfaces.C.int (Y1),
+ Interfaces.C.int (X2), Interfaces.C.int (Y2));
+ end Line;
+
+
+ procedure Outline
+ (X0, Y0 : in Integer;
+ X1, Y1 : in Integer;
+ X2, Y2 : in Integer) is
+ begin
+ fl_draw_loop
+ (Interfaces.C.int (X0), Interfaces.C.int (Y0),
+ Interfaces.C.int (X1), Interfaces.C.int (Y1),
+ Interfaces.C.int (X2), Interfaces.C.int (Y2));
+ end Outline;
+
+
+ procedure Outline
+ (X0, Y0 : in Integer;
+ X1, Y1 : in Integer;
+ X2, Y2 : in Integer;
+ X3, Y3 : in Integer) is
+ begin
+ fl_draw_loop2
+ (Interfaces.C.int (X0), Interfaces.C.int (Y0),
+ Interfaces.C.int (X1), Interfaces.C.int (Y1),
+ Interfaces.C.int (X2), Interfaces.C.int (Y2),
+ Interfaces.C.int (X3), Interfaces.C.int (Y3));
+ end Outline;
+
+
+ procedure Pie
+ (X, Y, W, H : in Integer;
+ Angle1, Angle2 : in Long_Float) is
+ begin
+ fl_draw_pie
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.double (Angle1),
+ Interfaces.C.double (Angle2));
+ end Pie;
+
+
+ procedure Point
+ (X, Y : in Integer) is
+ begin
+ fl_draw_point
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Point;
+
+
+ procedure Polygon
+ (X0, Y0 : in Integer;
+ X1, Y1 : in Integer;
+ X2, Y2 : in Integer) is
+ begin
+ fl_draw_polygon
+ (Interfaces.C.int (X0), Interfaces.C.int (Y0),
+ Interfaces.C.int (X1), Interfaces.C.int (Y1),
+ Interfaces.C.int (X2), Interfaces.C.int (Y2));
+ end Polygon;
+
+
+ procedure Polygon
+ (X0, Y0 : in Integer;
+ X1, Y1 : in Integer;
+ X2, Y2 : in Integer;
+ X3, Y3 : in Integer) is
+ begin
+ fl_draw_polygon2
+ (Interfaces.C.int (X0), Interfaces.C.int (Y0),
+ Interfaces.C.int (X1), Interfaces.C.int (Y1),
+ Interfaces.C.int (X2), Interfaces.C.int (Y2),
+ Interfaces.C.int (X3), Interfaces.C.int (Y3));
+ end Polygon;
+
+
+ procedure Rect
+ (X, Y, W, H : in Integer) is
+ begin
+ fl_draw_rect
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Rect;
+
+
+ procedure Rect
+ (X, Y, W, H : in Integer;
+ Hue : in Color) is
+ begin
+ fl_draw_rect2
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.unsigned (Hue));
+ end Rect;
+
+
+ procedure Rect_Fill
+ (X, Y, W, H : in Integer) is
+ begin
+ fl_draw_rect_fill
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Rect_Fill;
+
+
+ procedure Rect_Fill
+ (X, Y, W, H : in Integer;
+ Hue : in Color) is
+ begin
+ fl_draw_rect_fill2
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.unsigned (Hue));
+ end Rect_Fill;
+
+
+ procedure Rect_Fill
+ (X, Y, W, H : in Integer;
+ R, G, B : in Color_Component) is
+ begin
+ fl_draw_rect_fill3
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.unsigned_char (R),
+ Interfaces.C.unsigned_char (G),
+ Interfaces.C.unsigned_char (B));
+ end Rect_Fill;
+
+
+ procedure Ecks_Why_Line
+ (X0, Y0, X1 : in Integer) is
+ begin
+ fl_draw_xy_line
+ (Interfaces.C.int (X0),
+ Interfaces.C.int (Y0),
+ Interfaces.C.int (X1));
+ end Ecks_Why_Line;
+
+
+ procedure Ecks_Why_Line
+ (X0, Y0, X1, Y2 : in Integer) is
+ begin
+ fl_draw_xy_line2
+ (Interfaces.C.int (X0),
+ Interfaces.C.int (Y0),
+ Interfaces.C.int (X1),
+ Interfaces.C.int (Y2));
+ end Ecks_Why_Line;
+
+
+ procedure Ecks_Why_Line
+ (X0, Y0, X1, Y2, X3 : in Integer) is
+ begin
+ fl_draw_xy_line3
+ (Interfaces.C.int (X0),
+ Interfaces.C.int (Y0),
+ Interfaces.C.int (X1),
+ Interfaces.C.int (Y2),
+ Interfaces.C.int (X3));
+ end Ecks_Why_Line;
+
+
+ procedure Why_Ecks_Line
+ (X0, Y0, Y1 : in Integer) is
+ begin
+ fl_draw_yx_line
+ (Interfaces.C.int (X0),
+ Interfaces.C.int (Y0),
+ Interfaces.C.int (Y1));
+ end Why_Ecks_Line;
+
+
+ procedure Why_Ecks_Line
+ (X0, Y0, Y1, X2 : in Integer) is
+ begin
+ fl_draw_yx_line2
+ (Interfaces.C.int (X0),
+ Interfaces.C.int (Y0),
+ Interfaces.C.int (Y1),
+ Interfaces.C.int (X2));
+ end Why_Ecks_Line;
+
+
+ procedure Why_Ecks_Line
+ (X0, Y0, Y1, X2, Y3 : in Integer) is
+ begin
+ fl_draw_yx_line3
+ (Interfaces.C.int (X0),
+ Interfaces.C.int (Y0),
+ Interfaces.C.int (Y1),
+ Interfaces.C.int (X2),
+ Interfaces.C.int (Y3));
+ end Why_Ecks_Line;
+
+
+ procedure End_Complex_Polygon is
+ begin
+ fl_draw_end_complex_polygon;
+ end End_Complex_Polygon;
+
+ procedure End_Line is
+ begin
+ fl_draw_end_line;
+ end End_Line;
+
+ procedure End_Loop is
+ begin
+ fl_draw_end_loop;
+ end End_Loop;
+
+ procedure End_Points is
+ begin
+ fl_draw_end_points;
+ end End_Points;
+
+ procedure End_Polygon is
+ begin
+ fl_draw_end_polygon;
+ end End_Polygon;
+
+
+end FLTK.Draw;
+
+
diff --git a/body/fltk-environment.adb b/body/fltk-environment.adb
new file mode 100644
index 0000000..22cf676
--- /dev/null
+++ b/body/fltk-environment.adb
@@ -0,0 +1,1089 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Environment is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Constants From C --
+ ------------------------
+
+ root_fl_prefs_system : constant Interfaces.C.int;
+ pragma Import (C, root_fl_prefs_system, "root_fl_prefs_system");
+
+ root_fl_prefs_user : constant Interfaces.C.int;
+ pragma Import (C, root_fl_prefs_user, "root_fl_prefs_user");
+
+ const_fl_path_max : constant Interfaces.C.int;
+ pragma Import (C, const_fl_path_max, "const_fl_path_max");
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function fl_preferences_new_uuid
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_preferences_new_uuid, "fl_preferences_new_uuid");
+ pragma Inline (fl_preferences_new_uuid);
+
+
+
+
+ function new_fl_pref_database_path
+ (P, V, A : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_pref_database_path, "new_fl_pref_database_path");
+ pragma Inline (new_fl_pref_database_path);
+
+ function new_fl_pref_database_scope
+ (S : in Interfaces.C.int;
+ V, A : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_pref_database_scope, "new_fl_pref_database_scope");
+ pragma Inline (new_fl_pref_database_scope);
+
+ procedure upref_fl_pref_database
+ (P : in Storage.Integer_Address);
+ pragma Import (C, upref_fl_pref_database, "upref_fl_pref_database");
+ pragma Inline (upref_fl_pref_database);
+
+ procedure free_fl_pref_database
+ (E : in Storage.Integer_Address);
+ pragma Import (C, free_fl_pref_database, "free_fl_pref_database");
+ pragma Inline (free_fl_pref_database);
+
+
+
+
+ function new_fl_pref_group_copy
+ (D : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_pref_group_copy, "new_fl_pref_group_copy");
+ pragma Inline (new_fl_pref_group_copy);
+
+ function new_fl_pref_group_memory
+ (N : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_pref_group_memory, "new_fl_pref_group_memory");
+ pragma Inline (new_fl_pref_group_memory);
+
+ function new_fl_pref_group_name
+ (G : in Storage.Integer_Address;
+ N : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_pref_group_name, "new_fl_pref_group_name");
+ pragma Inline (new_fl_pref_group_name);
+
+ function new_fl_pref_group_index
+ (G : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_pref_group_index, "new_fl_pref_group_index");
+ pragma Inline (new_fl_pref_group_index);
+
+ procedure free_fl_pref_group
+ (G : in Storage.Integer_Address);
+ pragma Import (C, free_fl_pref_group, "free_fl_pref_group");
+ pragma Inline (free_fl_pref_group);
+
+
+
+
+ procedure fl_preferences_flush
+ (E : in Storage.Integer_Address);
+ pragma Import (C, fl_preferences_flush, "fl_preferences_flush");
+ pragma Inline (fl_preferences_flush);
+
+ function fl_preferences_getuserdatapath
+ (E : in Storage.Integer_Address;
+ P : in Interfaces.C.char_array;
+ L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_getuserdatapath, "fl_preferences_getuserdatapath");
+ pragma Inline (fl_preferences_getuserdatapath);
+
+
+
+
+ function fl_preferences_deleteentry
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_deleteentry, "fl_preferences_deleteentry");
+ pragma Inline (fl_preferences_deleteentry);
+
+ function fl_preferences_deleteallentries
+ (E : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_deleteallentries, "fl_preferences_deleteallentries");
+ pragma Inline (fl_preferences_deleteallentries);
+
+ function fl_preferences_deletegroup
+ (P : in Storage.Integer_Address;
+ G : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_deletegroup, "fl_preferences_deletegroup");
+ pragma Inline (fl_preferences_deletegroup);
+
+ function fl_preferences_deleteallgroups
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_deleteallgroups, "fl_preferences_deleteallgroups");
+ pragma Inline (fl_preferences_deleteallgroups);
+
+ function fl_preferences_clear
+ (E : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_clear, "fl_preferences_clear");
+ pragma Inline (fl_preferences_clear);
+
+
+
+
+ function fl_preferences_entries
+ (E : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_entries, "fl_preferences_entries");
+ pragma Inline (fl_preferences_entries);
+
+ function fl_preferences_entry
+ (E : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_preferences_entry, "fl_preferences_entry");
+ pragma Inline (fl_preferences_entry);
+
+ function fl_preferences_entryexists
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_entryexists, "fl_preferences_entryexists");
+ pragma Inline (fl_preferences_entryexists);
+
+ function fl_preferences_size
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_size, "fl_preferences_size");
+ pragma Inline (fl_preferences_size);
+
+
+
+
+ function fl_preferences_groups
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_groups, "fl_preferences_groups");
+ pragma Inline (fl_preferences_groups);
+
+ function fl_preferences_group
+ (P : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_preferences_group, "fl_preferences_group");
+ pragma Inline (fl_preferences_group);
+
+ function fl_preferences_groupexists
+ (P : in Storage.Integer_Address;
+ G : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_groupexists, "fl_preferences_groupexists");
+ pragma Inline (fl_preferences_groupexists);
+
+
+
+
+ function fl_preferences_name
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_preferences_name, "fl_preferences_name");
+ pragma Inline (fl_preferences_name);
+
+ function fl_preferences_path
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_preferences_path, "fl_preferences_path");
+ pragma Inline (fl_preferences_path);
+
+
+
+
+ function fl_preferences_get_int
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : out Interfaces.C.int;
+ D : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_get_int, "fl_preferences_get_int");
+ pragma Inline (fl_preferences_get_int);
+
+ function fl_preferences_get_float
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : out Interfaces.C.C_float;
+ D : in Interfaces.C.C_float)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_get_float, "fl_preferences_get_float");
+ pragma Inline (fl_preferences_get_float);
+
+ function fl_preferences_get_double
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : out Interfaces.C.double;
+ D : in Interfaces.C.double)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_get_double, "fl_preferences_get_double");
+ pragma Inline (fl_preferences_get_double);
+
+ function fl_preferences_get_str
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : out Interfaces.C.Strings.chars_ptr;
+ D : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_get_str, "fl_preferences_get_str");
+ pragma Inline (fl_preferences_get_str);
+
+ function fl_preferences_get_str_limit
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : in Interfaces.C.char_array;
+ D : in Interfaces.C.char_array;
+ M : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_get_str_limit, "fl_preferences_get_str_limit");
+ pragma Inline (fl_preferences_get_str_limit);
+
+ function fl_preferences_get_void
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : out Storage.Integer_Address;
+ D : in Storage.Integer_Address;
+ DS : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_get_void, "fl_preferences_get_void");
+ pragma Inline (fl_preferences_get_void);
+
+ function fl_preferences_get_void_limit
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V, D : in Storage.Integer_Address;
+ DS, MS : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_get_void_limit, "fl_preferences_get_void_limit");
+ pragma Inline (fl_preferences_get_void_limit);
+
+ procedure free_fl_preferences_void_data
+ (V : in Storage.Integer_Address);
+ pragma Import (C, free_fl_preferences_void_data, "free_fl_preferences_void_data");
+ pragma Inline (free_fl_preferences_void_data);
+
+
+
+
+ function fl_preferences_set_int
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_set_int, "fl_preferences_set_int");
+ pragma Inline (fl_preferences_set_int);
+
+ function fl_preferences_set_float
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : in Interfaces.C.C_float)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_set_float, "fl_preferences_set_float");
+ pragma Inline (fl_preferences_set_float);
+
+ function fl_preferences_set_float_prec
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : in Interfaces.C.C_float;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_set_float_prec, "fl_preferences_set_float_prec");
+ pragma Inline (fl_preferences_set_float_prec);
+
+ function fl_preferences_set_double
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : in Interfaces.C.double)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_set_double, "fl_preferences_set_double");
+ pragma Inline (fl_preferences_set_double);
+
+ function fl_preferences_set_double_prec
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : in Interfaces.C.double;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_set_double_prec, "fl_preferences_set_double_prec");
+ pragma Inline (fl_preferences_set_double_prec);
+
+ function fl_preferences_set_str
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ V : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_set_str, "fl_preferences_set_str");
+ pragma Inline (fl_preferences_set_str);
+
+ function fl_preferences_set_void
+ (E : in Storage.Integer_Address;
+ K : in Interfaces.C.char_array;
+ D : in Storage.Integer_Address;
+ DS : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_preferences_set_void, "fl_preferences_set_void");
+ pragma Inline (fl_preferences_set_void);
+
+
+
+
+ ------------------------
+ -- Internal Utility --
+ ------------------------
+
+ function To_Cint
+ (Extent : in Scope)
+ return Interfaces.C.int is
+ begin
+ case Extent is
+ when Global =>
+ return root_fl_prefs_system;
+ when User =>
+ return root_fl_prefs_user;
+ end case;
+ end To_Cint;
+
+ function To_Scope
+ (Num : in Interfaces.C.int)
+ return Scope is
+ begin
+ if Num = root_fl_prefs_system then
+ return Global;
+ else
+ pragma Assert (Num = root_fl_prefs_user);
+ return User;
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end To_Scope;
+
+
+
+
+ -----------------------------------
+ -- Controlled Type Subprograms --
+ -----------------------------------
+
+ procedure Finalize
+ (This : in out Database) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_pref_database (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+ procedure Finalize
+ (This : in out Pref_Group) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_pref_group (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ if This.Root_Ptr /= Null_Pointer then
+ free_fl_pref_database (This.Root_Ptr);
+ end if;
+ end if;
+ end Finalize;
+
+
+
+
+ -----------------------
+ -- Preferences API --
+ -----------------------
+
+ function New_UUID
+ return String
+ is
+ Text : Interfaces.C.Strings.chars_ptr := fl_preferences_new_uuid;
+ begin
+ return Interfaces.C.Strings.Value (Text);
+ end New_UUID;
+
+
+
+
+ package body Forge is
+
+
+ function From_Filesystem
+ (Directory, Vendor, Application : in String)
+ return Database is
+ begin
+ return This : Database do
+ This.Void_Ptr := new_fl_pref_database_path
+ (Interfaces.C.To_C (Directory),
+ Interfaces.C.To_C (Vendor),
+ Interfaces.C.To_C (Application));
+ end return;
+ end From_Filesystem;
+
+
+ function From_Scope
+ (Extent : in Scope;
+ Vendor, Application : in String)
+ return Database is
+ begin
+ return This : Database do
+ This.Void_Ptr := new_fl_pref_database_scope
+ (To_Cint (Extent),
+ Interfaces.C.To_C (Vendor),
+ Interfaces.C.To_C (Application));
+ end return;
+ end From_Scope;
+
+
+ function Root
+ (From : in Database)
+ return Pref_Group'Class is
+ begin
+ return Result : Pref_Group do
+ Result.Void_Ptr := new_fl_pref_group_copy (From.Void_Ptr);
+ Result.Root_Ptr := From.Void_Ptr;
+ upref_fl_pref_database (Result.Root_Ptr);
+ end return;
+ end Root;
+
+
+ function In_Memory
+ (Name : in String)
+ return Pref_Group is
+ begin
+ return Result : Pref_Group do
+ Result.Void_Ptr := new_fl_pref_group_memory (Interfaces.C.To_C (Name));
+ Result.Root_Ptr := Null_Pointer;
+ end return;
+ end In_Memory;
+
+
+ function By_Name
+ (From : in Pref_Group;
+ Name : in String)
+ return Pref_Group'Class is
+ begin
+ return Result : Pref_Group do
+ Result.Void_Ptr := new_fl_pref_group_name
+ (From.Void_Ptr,
+ Interfaces.C.To_C (Name));
+ Result.Root_Ptr := From.Root_Ptr;
+ if Result.Root_Ptr /= Null_Pointer then
+ upref_fl_pref_database (Result.Root_Ptr);
+ end if;
+ end return;
+ end By_Name;
+
+
+ function By_Index
+ (From : in Pref_Group;
+ Index : in Positive)
+ return Pref_Group'Class is
+ begin
+ return Result : Pref_Group do
+ Result.Void_Ptr := new_fl_pref_group_index
+ (From.Void_Ptr,
+ Interfaces.C.int (Index - 1));
+ Result.Root_Ptr := From.Root_Ptr;
+ if Result.Root_Ptr /= Null_Pointer then
+ upref_fl_pref_database (Result.Root_Ptr);
+ end if;
+ end return;
+ end By_Index;
+
+
+ end Forge;
+
+
+
+
+ procedure Flush
+ (This : in Database) is
+ begin
+ fl_preferences_flush (This.Void_Ptr);
+ end Flush;
+
+
+ function Userdata_Path
+ (This : in Database)
+ return String
+ is
+ Buffer : Interfaces.C.char_array :=
+ (1 .. Interfaces.C.size_t (const_fl_path_max + 1) => ' ');
+ begin
+ if fl_preferences_getuserdatapath
+ (This.Void_Ptr,
+ Buffer,
+ const_fl_path_max) = 0
+ then
+ raise Preference_Error;
+ end if;
+ return Interfaces.C.To_Ada (Buffer);
+ end Userdata_Path;
+
+
+
+
+ procedure Delete_Entry
+ (This : in out Pref_Group;
+ Key : in String) is
+ begin
+ if fl_preferences_deleteentry (This.Void_Ptr, Interfaces.C.To_C (Key)) = 0 then
+ raise Preference_Error;
+ end if;
+ end Delete_Entry;
+
+
+ procedure Delete_All_Entries
+ (This : in out Pref_Group) is
+ begin
+ if fl_preferences_deleteallentries (This.Void_Ptr) = 0 then
+ raise Preference_Error;
+ end if;
+ end Delete_All_Entries;
+
+
+ procedure Delete_Group
+ (This : in out Pref_Group;
+ Name : in String) is
+ begin
+ if fl_preferences_deletegroup (This.Void_Ptr, Interfaces.C.To_C (Name)) = 0 then
+ raise Preference_Error;
+ end if;
+ end Delete_Group;
+
+
+ procedure Delete_All_Groups
+ (This : in out Pref_Group) is
+ begin
+ if fl_preferences_deleteallgroups (This.Void_Ptr) = 0 then
+ raise Preference_Error;
+ end if;
+ end Delete_All_Groups;
+
+
+ procedure Clear
+ (This : in out Pref_Group) is
+ begin
+ if fl_preferences_clear (This.Void_Ptr) = 0 then
+ raise Preference_Error;
+ end if;
+ end Clear;
+
+
+
+
+ function Number_Of_Entries
+ (This : in Pref_Group)
+ return Natural is
+ begin
+ return Natural (fl_preferences_entries (This.Void_Ptr));
+ end Number_Of_Entries;
+
+
+ function Entry_Key
+ (This : in Pref_Group;
+ Index : in Positive)
+ return String
+ is
+ Key : Interfaces.C.Strings.chars_ptr :=
+ fl_preferences_entry (This.Void_Ptr, Interfaces.C.int (Index) - 1);
+ begin
+ -- no need for dealloc?
+ if Key = Interfaces.C.Strings.Null_Ptr then
+ raise Preference_Error;
+ else
+ return Interfaces.C.Strings.Value (Key);
+ end if;
+ end Entry_Key;
+
+
+ function Key_Exists
+ (This : in Pref_Group;
+ Key : in String)
+ return Boolean is
+ begin
+ return fl_preferences_entryexists (This.Void_Ptr, Interfaces.C.To_C (Key)) /= 0;
+ end Key_Exists;
+
+
+ function Value_Size
+ (This : in Pref_Group;
+ Key : in String)
+ return Natural is
+ begin
+ return Natural (fl_preferences_size (This.Void_Ptr, Interfaces.C.To_C (Key)));
+ end Value_Size;
+
+
+
+
+ function Number_Of_Groups
+ (This : in Pref_Group)
+ return Natural is
+ begin
+ return Natural (fl_preferences_groups (This.Void_Ptr));
+ end Number_Of_Groups;
+
+
+ function Group_Name
+ (This : in Pref_Group;
+ Index : in Positive)
+ return String
+ is
+ Name : Interfaces.C.Strings.chars_ptr :=
+ fl_preferences_group (This.Void_Ptr, Interfaces.C.int (Index) - 1);
+ begin
+ -- no need for dealloc?
+ if Name = Interfaces.C.Strings.Null_Ptr then
+ raise Preference_Error;
+ else
+ return Interfaces.C.Strings.Value (Name);
+ end if;
+ end Group_Name;
+
+
+ function Group_Exists
+ (This : in Pref_Group;
+ Name : in String)
+ return Boolean is
+ begin
+ return fl_preferences_groupexists (This.Void_Ptr, Interfaces.C.To_C (Name)) /= 0;
+ end Group_Exists;
+
+
+
+
+ function At_Name
+ (This : in Pref_Group)
+ return String
+ is
+ Text : Interfaces.C.Strings.chars_ptr := fl_preferences_name (This.Void_Ptr);
+ begin
+ if Text = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Text);
+ end if;
+ end At_Name;
+
+
+ function At_Path
+ (This : in Pref_Group)
+ return String
+ is
+ Text : Interfaces.C.Strings.chars_ptr := fl_preferences_path (This.Void_Ptr);
+ begin
+ if Text = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Text);
+ end if;
+ end At_Path;
+
+
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String)
+ return Integer
+ is
+ Value : Interfaces.C.int;
+ begin
+ if fl_preferences_get_int
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Value, 0) = 0
+ then
+ raise Preference_Error;
+ end if;
+ return Integer (Value);
+ end Get;
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String;
+ Default : in Integer)
+ return Integer
+ is
+ Value, X : Interfaces.C.int;
+ begin
+ X := fl_preferences_get_int
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Value,
+ Interfaces.C.int (Default));
+ return Integer (Value);
+ end Get;
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String)
+ return Float
+ is
+ Value : Interfaces.C.C_float;
+ begin
+ if fl_preferences_get_float
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Value, 0.0) = 0
+ then
+ raise Preference_Error;
+ end if;
+ return Float (Value);
+ end Get;
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String;
+ Default : in Float)
+ return Float
+ is
+ Value : Interfaces.C.C_float;
+ X : Interfaces.C.int;
+ begin
+ X := fl_preferences_get_float
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Value,
+ Interfaces.C.C_float (Default));
+ return Float (Value);
+ end Get;
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String)
+ return Long_Float
+ is
+ Value : Interfaces.C.double;
+ begin
+ if fl_preferences_get_double
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Value, 0.0) = 0
+ then
+ raise Preference_Error;
+ end if;
+ return Long_Float (Value);
+ end Get;
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String;
+ Default : in Long_Float)
+ return Long_Float
+ is
+ Value : Interfaces.C.double;
+ X : Interfaces.C.int;
+ begin
+ X := fl_preferences_get_double
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Value,
+ Interfaces.C.double (Default));
+ return Long_Float (Value);
+ end Get;
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String)
+ return String
+ is
+ Text : Interfaces.C.Strings.chars_ptr;
+ Check : Interfaces.C.int := fl_preferences_get_str
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Text,
+ Interfaces.C.To_C ("default"));
+ begin
+ if Check = 0 then
+ raise Preference_Error;
+ end if;
+ if Text = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ end if;
+ return Str : String := Interfaces.C.Strings.Value (Text) do
+ Interfaces.C.Strings.Free (Text);
+ end return;
+ end Get;
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String;
+ Default : in String)
+ return String
+ is
+ Text : Interfaces.C.Strings.chars_ptr;
+ X : Interfaces.C.int := fl_preferences_get_str
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Text,
+ Interfaces.C.To_C (Default));
+ begin
+ if Text = Interfaces.C.Strings.Null_Ptr then
+ return Default;
+ end if;
+ return Str : String := Interfaces.C.Strings.Value (Text) do
+ Interfaces.C.Strings.Free (Text);
+ end return;
+ end Get;
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String;
+ Default : in String;
+ Max_Length : in Natural)
+ return String
+ is
+ Text : Interfaces.C.char_array := (1 .. Interfaces.C.size_t (Max_Length + 1) => ' ');
+ Check : Interfaces.C.int := fl_preferences_get_str_limit
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Text,
+ Interfaces.C.To_C (Default),
+ Interfaces.C.int (Max_Length));
+ begin
+ if Check = 0 then
+ return Default;
+ else
+ return Interfaces.C.To_Ada (Text);
+ end if;
+ end Get;
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String)
+ return Binary_Data
+ is
+ Thing : Storage.Integer_Address;
+ Dummy : Interfaces.C.int := 42;
+ Check : Interfaces.C.int := fl_preferences_get_void
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Thing,
+ Storage.To_Integer (Dummy'Address),
+ 1);
+ begin
+ if Check = 0 then
+ free_fl_preferences_void_data (Thing);
+ raise Preference_Error;
+ end if;
+ declare
+ Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size);
+ Actual : Binary_Data (1 .. Length);
+ for Actual'Address use Storage.To_Address (Thing);
+ pragma Import (Ada, Actual);
+ begin
+ return Result : Binary_Data := Actual do
+ free_fl_preferences_void_data (Thing);
+ end return;
+ end;
+ end Get;
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String;
+ Default : in Binary_Data)
+ return Binary_Data
+ is
+ Thing : Storage.Integer_Address;
+ Ignore : Interfaces.C.int := fl_preferences_get_void
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Thing,
+ Storage.To_Integer (Default'Address),
+ Default'Length / Interfaces.C.int (c_pointer_size));
+ Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size);
+ Actual : Binary_Data (1 .. Length);
+ for Actual'Address use Storage.To_Address (Thing);
+ pragma Import (Ada, Actual);
+ begin
+ return Result : Binary_Data := Actual do
+ free_fl_preferences_void_data (Thing);
+ end return;
+ end Get;
+
+
+ function Get
+ (This : in Pref_Group;
+ Key : in String;
+ Default : in Binary_Data;
+ Max_Length : in Natural)
+ return Binary_Data
+ is
+ Actual : Binary_Data (1 .. Max_Length);
+ Ignore : Interfaces.C.int := fl_preferences_get_void_limit
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Storage.To_Integer (Actual'Address),
+ Storage.To_Integer (Default'Address),
+ Default'Length / Interfaces.C.int (c_pointer_size),
+ Interfaces.C.int (Max_Length) / Interfaces.C.int (c_pointer_size));
+ Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size);
+ begin
+ return Actual (1 .. Length);
+ end Get;
+
+
+
+
+ procedure Set
+ (This : in out Pref_Group;
+ Key : in String;
+ Value : in Integer) is
+ begin
+ if fl_preferences_set_int
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Interfaces.C.int (Value)) = 0
+ then
+ raise Preference_Error;
+ end if;
+ end Set;
+
+
+ procedure Set
+ (This : in out Pref_Group;
+ Key : in String;
+ Value : in Float) is
+ begin
+ if fl_preferences_set_float
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Interfaces.C.C_float (Value)) = 0
+ then
+ raise Preference_Error;
+ end if;
+ end Set;
+
+
+ procedure Set
+ (This : in out Pref_Group;
+ Key : in String;
+ Value : in Float;
+ Precision : in Natural) is
+ begin
+ if fl_preferences_set_float_prec
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Interfaces.C.C_float (Value),
+ Interfaces.C.int (Precision)) = 0
+ then
+ raise Preference_Error;
+ end if;
+ end Set;
+
+
+ procedure Set
+ (This : in out Pref_Group;
+ Key : in String;
+ Value : in Long_Float) is
+ begin
+ if fl_preferences_set_double
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Interfaces.C.double (Value)) = 0
+ then
+ raise Preference_Error;
+ end if;
+ end Set;
+
+
+ procedure Set
+ (This : in out Pref_Group;
+ Key : in String;
+ Value : in Long_Float;
+ Precision : in Natural) is
+ begin
+ if fl_preferences_set_double_prec
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Interfaces.C.double (Value),
+ Interfaces.C.int (Precision)) = 0
+ then
+ raise Preference_Error;
+ end if;
+ end Set;
+
+
+ procedure Set
+ (This : in out Pref_Group;
+ Key : in String;
+ Value : in String) is
+ begin
+ if fl_preferences_set_str
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Interfaces.C.To_C (Value)) = 0
+ then
+ raise Preference_Error;
+ end if;
+ end Set;
+
+
+ procedure Set
+ (This : in out Pref_Group;
+ Key : in String;
+ Value : in Binary_Data) is
+ begin
+ if fl_preferences_set_void
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Key),
+ Storage.To_Integer (Value'Address),
+ Value'Length / Interfaces.C.int (c_pointer_size)) = 0
+ then
+ raise Preference_Error;
+ end if;
+ end Set;
+
+
+end FLTK.Environment;
+
diff --git a/body/fltk-errors.adb b/body/fltk-errors.adb
new file mode 100644
index 0000000..ef31002
--- /dev/null
+++ b/body/fltk-errors.adb
@@ -0,0 +1,101 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings;
+
+
+package body FLTK.Errors is
+
+
+ procedure fl_error_default_warning
+ (M : in Interfaces.C.char_array);
+ pragma Import (C, fl_error_default_warning, "fl_error_default_warning");
+ pragma Inline (fl_error_default_warning);
+
+ procedure fl_error_default_error
+ (M : in Interfaces.C.char_array);
+ pragma Import (C, fl_error_default_error, "fl_error_default_error");
+ pragma Inline (fl_error_default_error);
+
+ procedure fl_error_default_fatal
+ (M : in Interfaces.C.char_array);
+ pragma Import (C, fl_error_default_fatal, "fl_error_default_fatal");
+ pragma Inline (fl_error_default_fatal);
+
+ procedure fl_error_set_hooks;
+ pragma Import (C, fl_error_set_hooks, "fl_error_set_hooks");
+ pragma Inline (fl_error_set_hooks);
+
+
+
+
+ procedure Warning_Hook
+ (C_Mess : in Interfaces.C.Strings.chars_ptr);
+ pragma Export (C, Warning_Hook, "error_warning_hook");
+
+ procedure Warning_Hook
+ (C_Mess : in Interfaces.C.Strings.chars_ptr) is
+ begin
+ Current_Warning (Interfaces.C.Strings.Value (C_Mess));
+ end Warning_Hook;
+
+
+ procedure Error_Hook
+ (C_Mess : in Interfaces.C.Strings.chars_ptr);
+ pragma Export (C, Error_Hook, "error_error_hook");
+
+ procedure Error_Hook
+ (C_Mess : in Interfaces.C.Strings.chars_ptr) is
+ begin
+ Current_Error (Interfaces.C.Strings.Value (C_Mess));
+ end Error_Hook;
+
+
+ procedure Fatal_Hook
+ (C_Mess : in Interfaces.C.Strings.chars_ptr);
+ pragma Export (C, Fatal_Hook, "error_fatal_hook");
+
+ procedure Fatal_Hook
+ (C_Mess : in Interfaces.C.Strings.chars_ptr) is
+ begin
+ Current_Fatal (Interfaces.C.Strings.Value (C_Mess));
+ end Fatal_Hook;
+
+
+
+
+ procedure Default_Warning
+ (Message : in String) is
+ begin
+ fl_error_default_warning (Interfaces.C.To_C (Message));
+ end Default_Warning;
+
+
+ procedure Default_Error
+ (Message : in String) is
+ begin
+ fl_error_default_error (Interfaces.C.To_C (Message));
+ end Default_Error;
+
+
+ procedure Default_Fatal
+ (Message : in String) is
+ begin
+ fl_error_default_fatal (Interfaces.C.To_C (Message));
+ end Default_Fatal;
+
+
+begin
+
+
+ fl_error_set_hooks;
+
+
+end FLTK.Errors;
+
+
diff --git a/body/fltk-event.adb b/body/fltk-event.adb
new file mode 100644
index 0000000..4521fc2
--- /dev/null
+++ b/body/fltk-event.adb
@@ -0,0 +1,696 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Event is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ procedure fl_event_add_handler
+ (F : in Storage.Integer_Address);
+ pragma Import (C, fl_event_add_handler, "fl_event_add_handler");
+ pragma Inline (fl_event_add_handler);
+
+ procedure fl_event_set_event_dispatch
+ (F : in Storage.Integer_Address);
+ pragma Import (C, fl_event_set_event_dispatch, "fl_event_set_event_dispatch");
+ pragma Inline (fl_event_set_event_dispatch);
+
+ -- actually handle_ but can't have an underscore on the end of an identifier
+ function fl_event_handle
+ (E : in Interfaces.C.int;
+ W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_handle, "fl_event_handle");
+ pragma Inline (fl_event_handle);
+
+
+
+
+ function fl_event_get_grab
+ return Storage.Integer_Address;
+ pragma Import (C, fl_event_get_grab, "fl_event_get_grab");
+ pragma Inline (fl_event_get_grab);
+
+ procedure fl_event_set_grab
+ (T : in Storage.Integer_Address);
+ pragma Import (C, fl_event_set_grab, "fl_event_set_grab");
+ pragma Inline (fl_event_set_grab);
+
+ function fl_event_get_pushed
+ return Storage.Integer_Address;
+ pragma Import (C, fl_event_get_pushed, "fl_event_get_pushed");
+ pragma Inline (fl_event_get_pushed);
+
+ procedure fl_event_set_pushed
+ (T : in Storage.Integer_Address);
+ pragma Import (C, fl_event_set_pushed, "fl_event_set_pushed");
+ pragma Inline (fl_event_set_pushed);
+
+ function fl_event_get_belowmouse
+ return Storage.Integer_Address;
+ pragma Import (C, fl_event_get_belowmouse, "fl_event_get_belowmouse");
+ pragma Inline (fl_event_get_belowmouse);
+
+ procedure fl_event_set_belowmouse
+ (T : in Storage.Integer_Address);
+ pragma Import (C, fl_event_set_belowmouse, "fl_event_set_belowmouse");
+ pragma Inline (fl_event_set_belowmouse);
+
+ function fl_event_get_focus
+ return Storage.Integer_Address;
+ pragma Import (C, fl_event_get_focus, "fl_event_get_focus");
+ pragma Inline (fl_event_get_focus);
+
+ procedure fl_event_set_focus
+ (To : in Storage.Integer_Address);
+ pragma Import (C, fl_event_set_focus, "fl_event_set_focus");
+ pragma Inline (fl_event_set_focus);
+
+
+
+
+ function fl_event_compose
+ (D : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_compose, "fl_event_compose");
+ pragma Inline (fl_event_compose);
+
+ procedure fl_event_compose_reset;
+ pragma Import (C, fl_event_compose_reset, "fl_event_compose_reset");
+ pragma Inline (fl_event_compose_reset);
+
+ function fl_event_text
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_event_text, "fl_event_text");
+ pragma Inline (fl_event_text);
+
+ function fl_event_length
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_length, "fl_event_length");
+ pragma Inline (fl_event_length);
+
+
+
+
+ function fl_event_get
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_get, "fl_event_get");
+ pragma Inline (fl_event_get);
+
+ function fl_event_state
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_state, "fl_event_state");
+ pragma Inline (fl_event_state);
+
+ function fl_event_check_state
+ (S : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_check_state, "fl_event_check_state");
+ pragma Inline (fl_event_check_state);
+
+
+
+
+ function fl_event_x
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_x, "fl_event_x");
+ pragma Inline (fl_event_x);
+
+ function fl_event_x_root
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_x_root, "fl_event_x_root");
+ pragma Inline (fl_event_x_root);
+
+ function fl_event_y
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_y, "fl_event_y");
+ pragma Inline (fl_event_y);
+
+ function fl_event_y_root
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_y_root, "fl_event_y_root");
+ pragma Inline (fl_event_y_root);
+
+ function fl_event_dx
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_dx, "fl_event_dx");
+ pragma Inline (fl_event_dx);
+
+ function fl_event_dy
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_dy, "fl_event_dy");
+ pragma Inline (fl_event_dy);
+
+ procedure fl_event_get_mouse
+ (X, Y : out Interfaces.C.int);
+ pragma Import (C, fl_event_get_mouse, "fl_event_get_mouse");
+ pragma Inline (fl_event_get_mouse);
+
+ function fl_event_is_click
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_is_click, "fl_event_is_click");
+ pragma Inline (fl_event_is_click);
+
+ function fl_event_is_clicks
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_is_clicks, "fl_event_is_clicks");
+ pragma Inline (fl_event_is_clicks);
+
+ procedure fl_event_set_clicks
+ (C : in Interfaces.C.int);
+ pragma Import (C, fl_event_set_clicks, "fl_event_set_clicks");
+ pragma Inline (fl_event_set_clicks);
+
+ function fl_event_button
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_button, "fl_event_button");
+ pragma Inline (fl_event_button);
+
+ function fl_event_button1
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_button1, "fl_event_button1");
+ pragma Inline (fl_event_button1);
+
+ function fl_event_button2
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_button2, "fl_event_button2");
+ pragma Inline (fl_event_button2);
+
+ function fl_event_button3
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_button3, "fl_event_button3");
+ pragma Inline (fl_event_button3);
+
+ function fl_event_inside
+ (X, Y, W, H : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_inside, "fl_event_inside");
+ pragma Inline (fl_event_inside);
+
+
+
+
+ function fl_event_key
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_key, "fl_event_key");
+ pragma Inline (fl_event_key);
+
+ function fl_event_original_key
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_original_key, "fl_event_original_key");
+ pragma Inline (fl_event_original_key);
+
+ function fl_event_key_during
+ (K : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_key_during, "fl_event_key_during");
+ pragma Inline (fl_event_key_during);
+
+ function fl_event_get_key
+ (K : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_get_key, "fl_event_get_key");
+ pragma Inline (fl_event_get_key);
+
+ function fl_event_ctrl
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_ctrl, "fl_event_ctrl");
+ pragma Inline (fl_event_ctrl);
+
+ function fl_event_alt
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_alt, "fl_event_alt");
+ pragma Inline (fl_event_alt);
+
+ function fl_event_command
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_command, "fl_event_command");
+ pragma Inline (fl_event_command);
+
+ function fl_event_shift
+ return Interfaces.C.int;
+ pragma Import (C, fl_event_shift, "fl_event_shift");
+ pragma Inline (fl_event_shift);
+
+
+
+
+ function Event_Handler_Hook
+ (Num : in Interfaces.C.int)
+ return Interfaces.C.int
+ is
+ Ret_Val : Event_Outcome;
+ begin
+ for Func of reverse Handlers loop
+ Ret_Val := Func (Event_Kind'Val (Num));
+ if Ret_Val /= Not_Handled then
+ return Event_Outcome'Pos (Ret_Val);
+ end if;
+ end loop;
+ return Event_Outcome'Pos (Not_Handled);
+ end Event_Handler_Hook;
+
+
+ -- function Dispatch_Hook
+ -- (Num : in Interfaces.C.int;
+ -- Ptr : in Storage.Integer_Address)
+ -- return Interfaces.C.int
+ -- is
+ -- Ret_Val : Event_Outcome;
+ -- Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class;
+ -- begin
+ -- if Ptr /= Null_Pointer then
+ -- Actual_Window := Window_Convert.To_Pointer
+ -- (Storage.To_Address (fl_widget_get_user_data (Ptr)));
+ -- end if;
+ -- if Current_Dispatch = null then
+ -- Ret_Val := Default_Dispatch (Event_Kind'Val (Num), Actual_Window);
+ -- else
+ -- Ret_Val := Current_Dispatch (Event_Kind'Val (Num), Actual_Window);
+ -- end if;
+ -- return Event_Outcome'Pos (Ret_Val);
+ -- end Dispatch_Hook;
+
+
+
+
+ procedure Add_Handler
+ (Func : in Event_Handler) is
+ begin
+ Handlers.Append (Func);
+ end Add_Handler;
+
+
+ procedure Remove_Handler
+ (Func : in Event_Handler) is
+ begin
+ for I in reverse Handlers.First_Index .. Handlers.Last_Index loop
+ if Handlers (I) = Func then
+ Handlers.Delete (I);
+ return;
+ end if;
+ end loop;
+ end Remove_Handler;
+
+
+ -- function Get_Dispatch
+ -- return Event_Dispatch is
+ -- begin
+ -- if Current_Dispatch = null then
+ -- return Default_Dispatch'Access;
+ -- else
+ -- return Current_Dispatch;
+ -- end if;
+ -- end Get_Dispatch;
+
+
+ -- procedure Set_Dispatch
+ -- (Func : in Event_Dispatch) is
+ -- begin
+ -- Current_Dispatch := Func;
+ -- end Set_Dispatch;
+
+
+ -- function Default_Dispatch
+ -- (Event : in Event_Kind;
+ -- Win : access FLTK.Widgets.Groups.Windows.Window'Class)
+ -- return Event_Outcome is
+ -- begin
+ -- if Win = null then
+ -- return Event_Outcome'Val (fl_event_handle
+ -- (Event_Kind'Pos (Event), Null_Pointer));
+ -- else
+ -- return Event_Outcome'Val (fl_event_handle
+ -- (Event_Kind'Pos (Event),
+ -- Wrapper (Win.all).Void_Ptr));
+ -- end if;
+ -- end Default_Dispatch;
+
+
+
+
+ function Get_Grab
+ return access FLTK.Widgets.Groups.Windows.Window'Class
+ is
+ Grab_Ptr : Storage.Integer_Address := fl_event_get_grab;
+ Actual_Grab : access FLTK.Widgets.Groups.Windows.Window'Class;
+ begin
+ if Grab_Ptr /= Null_Pointer then
+ Grab_Ptr := fl_widget_get_user_data (Grab_Ptr);
+ pragma Assert (Grab_Ptr /= Null_Pointer);
+ Actual_Grab := Window_Convert.To_Pointer (Storage.To_Address (Grab_Ptr));
+ end if;
+ return Actual_Grab;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Grab;
+
+
+ procedure Set_Grab
+ (To : in FLTK.Widgets.Groups.Windows.Window'Class) is
+ begin
+ fl_event_set_grab (Wrapper (To).Void_Ptr);
+ end Set_Grab;
+
+
+ procedure Release_Grab is
+ begin
+ fl_event_set_grab (Null_Pointer);
+ end Release_Grab;
+
+
+ function Get_Pushed
+ return access FLTK.Widgets.Widget'Class
+ is
+ Pushed_Ptr : Storage.Integer_Address := fl_event_get_pushed;
+ Actual_Pushed : access FLTK.Widgets.Widget'Class;
+ begin
+ if Pushed_Ptr /= Null_Pointer then
+ Pushed_Ptr := fl_widget_get_user_data (Pushed_Ptr);
+ pragma Assert (Pushed_Ptr /= Null_Pointer);
+ Actual_Pushed := Widget_Convert.To_Pointer (Storage.To_Address (Pushed_Ptr));
+ end if;
+ return Actual_Pushed;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Pushed;
+
+
+ procedure Set_Pushed
+ (To : in FLTK.Widgets.Widget'Class) is
+ begin
+ fl_event_set_pushed (Wrapper (To).Void_Ptr);
+ end Set_Pushed;
+
+
+ function Get_Below_Mouse
+ return access FLTK.Widgets.Widget'Class
+ is
+ Below_Ptr : Storage.Integer_Address := fl_event_get_belowmouse;
+ Actual_Below : access FLTK.Widgets.Widget'Class;
+ begin
+ if Below_Ptr /= Null_Pointer then
+ Below_Ptr := fl_widget_get_user_data (Below_Ptr);
+ pragma Assert (Below_Ptr /= Null_Pointer);
+ Actual_Below := Widget_Convert.To_Pointer (Storage.To_Address (Below_Ptr));
+ end if;
+ return Actual_Below;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Below_Mouse;
+
+
+ procedure Set_Below_Mouse
+ (To : in FLTK.Widgets.Widget'Class) is
+ begin
+ fl_event_set_belowmouse (Wrapper (To).Void_Ptr);
+ end Set_Below_Mouse;
+
+
+ function Get_Focus
+ return access FLTK.Widgets.Widget'Class
+ is
+ Focus_Ptr : Storage.Integer_Address := fl_event_get_focus;
+ Actual_Focus : access FLTK.Widgets.Widget'Class;
+ begin
+ if Focus_Ptr /= Null_Pointer then
+ Focus_Ptr := fl_widget_get_user_data (Focus_Ptr);
+ pragma Assert (Focus_Ptr /= Null_Pointer);
+ Actual_Focus := Widget_Convert.To_Pointer (Storage.To_Address (Focus_Ptr));
+ end if;
+ return Actual_Focus;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Focus;
+
+
+ procedure Set_Focus
+ (To : in FLTK.Widgets.Widget'Class) is
+ begin
+ fl_event_set_focus (Wrapper (To).Void_Ptr);
+ end Set_Focus;
+
+
+
+
+ function Compose
+ (Del : out Natural)
+ return Boolean is
+ begin
+ return fl_event_compose (Interfaces.C.int (Del)) /= 0;
+ end Compose;
+
+ procedure Compose_Reset is
+ begin
+ fl_event_compose_reset;
+ end Compose_Reset;
+
+
+ function Text
+ return String
+ is
+ Str : Interfaces.C.Strings.chars_ptr := fl_event_text;
+ begin
+ if Str = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Str, Interfaces.C.size_t (fl_event_length));
+ end if;
+ end Text;
+
+
+ function Text_Length
+ return Natural is
+ begin
+ return Natural (fl_event_length);
+ end Text_Length;
+
+
+
+
+ function Last
+ return Event_Kind is
+ begin
+ return Event_Kind'Val (fl_event_get);
+ end Last;
+
+
+ function Last_Modifier
+ return Modifier is
+ begin
+ return To_Ada (fl_event_state);
+ end Last_Modifier;
+
+
+ function Last_Modifier
+ (Had : in Modifier)
+ return Boolean is
+ begin
+ return fl_event_check_state (To_C (Had)) /= 0;
+ end Last_Modifier;
+
+
+
+
+ function Mouse_X
+ return Integer is
+ begin
+ return Integer (fl_event_x);
+ end Mouse_X;
+
+
+ function Mouse_X_Root
+ return Integer is
+ begin
+ return Integer (fl_event_x_root);
+ end Mouse_X_Root;
+
+
+ function Mouse_Y
+ return Integer is
+ begin
+ return Integer (fl_event_y);
+ end Mouse_Y;
+
+
+ function Mouse_Y_Root
+ return Integer is
+ begin
+ return Integer (fl_event_y_root);
+ end Mouse_Y_Root;
+
+
+
+ function Mouse_DX
+ return Integer is
+ begin
+ return Integer (fl_event_dx);
+ end Mouse_DX;
+
+
+ function Mouse_DY
+ return Integer is
+ begin
+ return Integer (fl_event_dy);
+ end Mouse_DY;
+
+
+ procedure Get_Mouse
+ (X, Y : out Integer) is
+ begin
+ fl_event_get_mouse (Interfaces.C.int (X), Interfaces.C.int (Y));
+ end Get_Mouse;
+
+
+ function Is_Click
+ return Boolean is
+ begin
+ return fl_event_is_click /= 0;
+ end Is_Click;
+
+
+ function Is_Multi_Click
+ return Boolean is
+ begin
+ return fl_event_is_clicks /= 0;
+ end Is_Multi_Click;
+
+
+ procedure Set_Clicks
+ (To : in Natural) is
+ begin
+ fl_event_set_clicks (Interfaces.C.int (To));
+ end Set_Clicks;
+
+
+ function Last_Button
+ return Mouse_Button is
+ begin
+ return Mouse_Button'Val (fl_event_button);
+ end Last_Button;
+
+
+ function Mouse_Left
+ return Boolean is
+ begin
+ return fl_event_button1 /= 0;
+ end Mouse_Left;
+
+
+ function Mouse_Middle
+ return Boolean is
+ begin
+ return fl_event_button2 /= 0;
+ end Mouse_Middle;
+
+
+ function Mouse_Right
+ return Boolean is
+ begin
+ return fl_event_button3 /= 0;
+ end Mouse_Right;
+
+
+ function Is_Inside
+ (X, Y, W, H : in Integer)
+ return Boolean is
+ begin
+ return fl_event_inside
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H)) /= 0;
+ end Is_Inside;
+
+
+
+
+ function Last_Key
+ return Keypress is
+ begin
+ return To_Ada (fl_event_key);
+ end Last_Key;
+
+
+ function Original_Last_Key
+ return Keypress is
+ begin
+ return To_Ada (fl_event_original_key);
+ end Original_Last_Key;
+
+
+ function Pressed_During
+ (Key : in Keypress)
+ return Boolean is
+ begin
+ return fl_event_key_during (To_C (Key)) /= 0;
+ end Pressed_During;
+
+
+ function Key_Now
+ (Key : in Keypress)
+ return Boolean is
+ begin
+ return fl_event_get_key (To_C (Key)) /= 0;
+ end Key_Now;
+
+
+ function Key_Ctrl
+ return Boolean is
+ begin
+ return fl_event_ctrl /= 0;
+ end Key_Ctrl;
+
+
+ function Key_Alt
+ return Boolean is
+ begin
+ return fl_event_alt /= 0;
+ end Key_Alt;
+
+
+ function Key_Command
+ return Boolean is
+ begin
+ return fl_event_command /= 0;
+ end Key_Command;
+
+
+ function Key_Shift
+ return Boolean is
+ begin
+ return fl_event_shift /= 0;
+ end Key_Shift;
+
+
+begin
+
+
+ fl_event_add_handler (Storage.To_Integer (Event_Handler_Hook'Address));
+ -- fl_event_set_event_dispatch (Storage.To_Integer (Dispatch_Hook'Address));
+
+
+end FLTK.Event;
+
diff --git a/body/fltk-file_choosers.adb b/body/fltk-file_choosers.adb
new file mode 100644
index 0000000..5662f8a
--- /dev/null
+++ b/body/fltk-file_choosers.adb
@@ -0,0 +1,1308 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C.Strings,
+ System.Address_To_Access_Conversions;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.File_Choosers is
+
+
+ package Chk renames Ada.Assertions;
+
+ package File_Chooser_Convert is new System.Address_To_Access_Conversions (File_Chooser'Class);
+ package Widget_Convert is new System.Address_To_Access_Conversions (Widgets.Widget'Class);
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function fl_widget_get_user_data
+ (W : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data");
+ pragma Inline (fl_widget_get_user_data);
+
+ procedure fl_widget_set_user_data
+ (W, D : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data");
+ pragma Inline (fl_widget_set_user_data);
+
+ function fl_file_chooser_get_user_data
+ (F : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_file_chooser_get_user_data, "fl_file_chooser_get_user_data");
+ pragma Inline (fl_file_chooser_get_user_data);
+
+ procedure fl_file_chooser_set_user_data
+ (F, U : in Storage.Integer_Address);
+ pragma Import (C, fl_file_chooser_set_user_data, "fl_file_chooser_set_user_data");
+ pragma Inline (fl_file_chooser_set_user_data);
+
+
+
+
+ procedure file_chooser_setup_sort_hook;
+ pragma Import (C, file_chooser_setup_sort_hook, "file_chooser_setup_sort_hook");
+ pragma Inline (file_chooser_setup_sort_hook);
+
+
+
+
+ function new_fl_file_chooser
+ (N, P : in Interfaces.C.char_array;
+ K : in Interfaces.C.int;
+ T : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_file_chooser, "new_fl_file_chooser");
+ pragma Inline (new_fl_file_chooser);
+
+ procedure free_fl_file_chooser
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_file_chooser, "free_fl_file_chooser");
+ pragma Inline (free_fl_file_chooser);
+
+
+
+
+ function fl_file_chooser_newbutton
+ (F : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_file_chooser_newbutton, "fl_file_chooser_newbutton");
+ pragma Inline (fl_file_chooser_newbutton);
+
+ function fl_file_chooser_previewbutton
+ (F : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_file_chooser_previewbutton, "fl_file_chooser_previewbutton");
+ pragma Inline (fl_file_chooser_previewbutton);
+
+ function fl_file_chooser_showhiddenbutton
+ (F : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_file_chooser_showhiddenbutton, "fl_file_chooser_showhiddenbutton");
+ pragma Inline (fl_file_chooser_showhiddenbutton);
+
+
+
+
+ function fl_file_chooser_get_add_favorites_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_add_favorites_label,
+ "fl_file_chooser_get_add_favorites_label");
+ pragma Inline (fl_file_chooser_get_add_favorites_label);
+
+ procedure fl_file_chooser_set_add_favorites_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_add_favorites_label,
+ "fl_file_chooser_set_add_favorites_label");
+ pragma Inline (fl_file_chooser_set_add_favorites_label);
+
+ function fl_file_chooser_get_all_files_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_all_files_label, "fl_file_chooser_get_all_files_label");
+ pragma Inline (fl_file_chooser_get_all_files_label);
+
+ procedure fl_file_chooser_set_all_files_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_all_files_label, "fl_file_chooser_set_all_files_label");
+ pragma Inline (fl_file_chooser_set_all_files_label);
+
+ function fl_file_chooser_get_custom_filter_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_custom_filter_label,
+ "fl_file_chooser_get_custom_filter_label");
+ pragma Inline (fl_file_chooser_get_custom_filter_label);
+
+ procedure fl_file_chooser_set_custom_filter_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_custom_filter_label,
+ "fl_file_chooser_set_custom_filter_label");
+ pragma Inline (fl_file_chooser_set_custom_filter_label);
+
+ function fl_file_chooser_get_existing_file_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_existing_file_label,
+ "fl_file_chooser_get_existing_file_label");
+ pragma Inline (fl_file_chooser_get_existing_file_label);
+
+ procedure fl_file_chooser_set_existing_file_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_existing_file_label,
+ "fl_file_chooser_set_existing_file_label");
+ pragma Inline (fl_file_chooser_set_existing_file_label);
+
+ function fl_file_chooser_get_favorites_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_favorites_label, "fl_file_chooser_get_favorites_label");
+ pragma Inline (fl_file_chooser_get_favorites_label);
+
+ procedure fl_file_chooser_set_favorites_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_favorites_label, "fl_file_chooser_set_favorites_label");
+ pragma Inline (fl_file_chooser_set_favorites_label);
+
+ function fl_file_chooser_get_filename_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_filename_label, "fl_file_chooser_get_filename_label");
+ pragma Inline (fl_file_chooser_get_filename_label);
+
+ procedure fl_file_chooser_set_filename_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_filename_label, "fl_file_chooser_set_filename_label");
+ pragma Inline (fl_file_chooser_set_filename_label);
+
+ function fl_file_chooser_get_filesystems_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_filesystems_label,
+ "fl_file_chooser_get_filesystems_label");
+ pragma Inline (fl_file_chooser_get_filesystems_label);
+
+ procedure fl_file_chooser_set_filesystems_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_filesystems_label,
+ "fl_file_chooser_set_filesystems_label");
+ pragma Inline (fl_file_chooser_set_filesystems_label);
+
+ function fl_file_chooser_get_hidden_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_hidden_label, "fl_file_chooser_get_hidden_label");
+ pragma Inline (fl_file_chooser_get_hidden_label);
+
+ procedure fl_file_chooser_set_hidden_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_hidden_label, "fl_file_chooser_set_hidden_label");
+ pragma Inline (fl_file_chooser_set_hidden_label);
+
+ function fl_file_chooser_get_manage_favorites_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_manage_favorites_label,
+ "fl_file_chooser_get_manage_favorites_label");
+ pragma Inline (fl_file_chooser_get_manage_favorites_label);
+
+ procedure fl_file_chooser_set_manage_favorites_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_manage_favorites_label,
+ "fl_file_chooser_set_manage_favorites_label");
+ pragma Inline (fl_file_chooser_set_manage_favorites_label);
+
+ function fl_file_chooser_get_new_directory_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_new_directory_label,
+ "fl_file_chooser_get_new_directory_label");
+ pragma Inline (fl_file_chooser_get_new_directory_label);
+
+ procedure fl_file_chooser_set_new_directory_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_new_directory_label,
+ "fl_file_chooser_set_new_directory_label");
+ pragma Inline (fl_file_chooser_set_new_directory_label);
+
+ function fl_file_chooser_get_new_directory_tooltip
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_new_directory_tooltip,
+ "fl_file_chooser_get_new_directory_tooltip");
+ pragma Inline (fl_file_chooser_get_new_directory_tooltip);
+
+ procedure fl_file_chooser_set_new_directory_tooltip
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_new_directory_tooltip,
+ "fl_file_chooser_set_new_directory_tooltip");
+ pragma Inline (fl_file_chooser_set_new_directory_tooltip);
+
+ function fl_file_chooser_get_preview_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_preview_label, "fl_file_chooser_get_preview_label");
+ pragma Inline (fl_file_chooser_get_preview_label);
+
+ procedure fl_file_chooser_set_preview_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_preview_label, "fl_file_chooser_set_preview_label");
+ pragma Inline (fl_file_chooser_set_preview_label);
+
+ function fl_file_chooser_get_save_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_save_label, "fl_file_chooser_get_save_label");
+ pragma Inline (fl_file_chooser_get_save_label);
+
+ procedure fl_file_chooser_set_save_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_save_label, "fl_file_chooser_set_save_label");
+ pragma Inline (fl_file_chooser_set_save_label);
+
+ function fl_file_chooser_get_show_label
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_show_label, "fl_file_chooser_get_show_label");
+ pragma Inline (fl_file_chooser_get_show_label);
+
+ procedure fl_file_chooser_set_show_label
+ (V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_show_label, "fl_file_chooser_set_show_label");
+ pragma Inline (fl_file_chooser_set_show_label);
+
+
+
+
+ function fl_file_chooser_add_extra
+ (F, W : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_file_chooser_add_extra, "fl_file_chooser_add_extra");
+ pragma Inline (fl_file_chooser_add_extra);
+
+ procedure fl_file_chooser_callback
+ (F, C, U : in Storage.Integer_Address);
+ pragma Import (C, fl_file_chooser_callback, "fl_file_chooser_callback");
+ pragma Inline (fl_file_chooser_callback);
+
+
+
+
+ function fl_file_chooser_get_color
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_file_chooser_get_color, "fl_file_chooser_get_color");
+ pragma Inline (fl_file_chooser_get_color);
+
+ procedure fl_file_chooser_set_color
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.unsigned);
+ pragma Import (C, fl_file_chooser_set_color, "fl_file_chooser_set_color");
+ pragma Inline (fl_file_chooser_set_color);
+
+ function fl_file_chooser_get_iconsize
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.unsigned_char;
+ pragma Import (C, fl_file_chooser_get_iconsize, "fl_file_chooser_get_iconsize");
+ pragma Inline (fl_file_chooser_get_iconsize);
+
+ procedure fl_file_chooser_set_iconsize
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_file_chooser_set_iconsize, "fl_file_chooser_set_iconsize");
+ pragma Inline (fl_file_chooser_set_iconsize);
+
+ function fl_file_chooser_get_label
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_label, "fl_file_chooser_get_label");
+ pragma Inline (fl_file_chooser_get_label);
+
+ procedure fl_file_chooser_set_label
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_label, "fl_file_chooser_set_label");
+ pragma Inline (fl_file_chooser_set_label);
+
+ function fl_file_chooser_get_ok_label
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_ok_label, "fl_file_chooser_get_ok_label");
+ pragma Inline (fl_file_chooser_get_ok_label);
+
+ procedure fl_file_chooser_set_ok_label
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_ok_label, "fl_file_chooser_set_ok_label");
+ pragma Inline (fl_file_chooser_set_ok_label);
+
+ function fl_file_chooser_get_preview
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_chooser_get_preview, "fl_file_chooser_get_preview");
+ pragma Inline (fl_file_chooser_get_preview);
+
+ procedure fl_file_chooser_set_preview
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_file_chooser_set_preview, "fl_file_chooser_set_preview");
+ pragma Inline (fl_file_chooser_set_preview);
+
+ function fl_file_chooser_get_textcolor
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_file_chooser_get_textcolor, "fl_file_chooser_get_textcolor");
+ pragma Inline (fl_file_chooser_get_textcolor);
+
+ procedure fl_file_chooser_set_textcolor
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.unsigned);
+ pragma Import (C, fl_file_chooser_set_textcolor, "fl_file_chooser_set_textcolor");
+ pragma Inline (fl_file_chooser_set_textcolor);
+
+ function fl_file_chooser_get_textfont
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_chooser_get_textfont, "fl_file_chooser_get_textfont");
+ pragma Inline (fl_file_chooser_get_textfont);
+
+ procedure fl_file_chooser_set_textfont
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_file_chooser_set_textfont, "fl_file_chooser_set_textfont");
+ pragma Inline (fl_file_chooser_set_textfont);
+
+ function fl_file_chooser_get_textsize
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_chooser_get_textsize, "fl_file_chooser_get_textsize");
+ pragma Inline (fl_file_chooser_get_textsize);
+
+ procedure fl_file_chooser_set_textsize
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_file_chooser_set_textsize, "fl_file_chooser_set_textsize");
+ pragma Inline (fl_file_chooser_set_textsize);
+
+ function fl_file_chooser_get_type
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_chooser_get_type, "fl_file_chooser_get_type");
+ pragma Inline (fl_file_chooser_get_type);
+
+ procedure fl_file_chooser_set_type
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_file_chooser_set_type, "fl_file_chooser_set_type");
+ pragma Inline (fl_file_chooser_set_type);
+
+
+
+
+ function fl_file_chooser_count
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_chooser_count, "fl_file_chooser_count");
+ pragma Inline (fl_file_chooser_count);
+
+ function fl_file_chooser_get_directory
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_directory, "fl_file_chooser_get_directory");
+ pragma Inline (fl_file_chooser_get_directory);
+
+ procedure fl_file_chooser_set_directory
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_directory, "fl_file_chooser_set_directory");
+ pragma Inline (fl_file_chooser_set_directory);
+
+ function fl_file_chooser_get_filter
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_filter, "fl_file_chooser_get_filter");
+ pragma Inline (fl_file_chooser_get_filter);
+
+ procedure fl_file_chooser_set_filter
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_file_chooser_set_filter, "fl_file_chooser_set_filter");
+ pragma Inline (fl_file_chooser_set_filter);
+
+ function fl_file_chooser_get_filter_value
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_chooser_get_filter_value, "fl_file_chooser_get_filter_value");
+ pragma Inline (fl_file_chooser_get_filter_value);
+
+ procedure fl_file_chooser_set_filter_value
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_file_chooser_set_filter_value, "fl_file_chooser_set_filter_value");
+ pragma Inline (fl_file_chooser_set_filter_value);
+
+ procedure fl_file_chooser_rescan
+ (F : in Storage.Integer_Address);
+ pragma Import (C, fl_file_chooser_rescan, "fl_file_chooser_rescan");
+ pragma Inline (fl_file_chooser_rescan);
+
+ procedure fl_file_chooser_rescan_keep_filename
+ (F : in Storage.Integer_Address);
+ pragma Import (C, fl_file_chooser_rescan_keep_filename, "fl_file_chooser_rescan_keep_filename");
+ pragma Inline (fl_file_chooser_rescan_keep_filename);
+
+ function fl_file_chooser_get_value
+ (F : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_chooser_get_value, "fl_file_chooser_get_value");
+ pragma Inline (fl_file_chooser_get_value);
+
+ procedure fl_file_chooser_set_value
+ (F : in Storage.Integer_Address;
+ V : in Interfaces.C.char_array);
+ pragma Import (C, fl_file_chooser_set_value, "fl_file_chooser_set_value");
+ pragma Inline (fl_file_chooser_set_value);
+
+
+
+
+ procedure fl_file_chooser_show
+ (F : in Storage.Integer_Address);
+ pragma Import (C, fl_file_chooser_show, "fl_file_chooser_show");
+ pragma Inline (fl_file_chooser_show);
+
+ procedure fl_file_chooser_hide
+ (F : in Storage.Integer_Address);
+ pragma Import (C, fl_file_chooser_hide, "fl_file_chooser_hide");
+ pragma Inline (fl_file_chooser_hide);
+
+ function fl_file_chooser_shown
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_chooser_shown, "fl_file_chooser_shown");
+ pragma Inline (fl_file_chooser_shown);
+
+ function fl_file_chooser_visible
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_chooser_visible, "fl_file_chooser_visible");
+ pragma Inline (fl_file_chooser_visible);
+
+
+
+
+ ----------------------
+ -- Callback Hooks --
+ ----------------------
+
+ function File_Chooser_Sort_Hook
+ (A, B : in Interfaces.C.Strings.chars_ptr)
+ return Interfaces.C.int;
+
+ pragma Export (C, File_Chooser_Sort_Hook, "file_chooser_sort_hook");
+
+ function File_Chooser_Sort_Hook
+ (A, B : in Interfaces.C.Strings.chars_ptr)
+ return Interfaces.C.int is
+ begin
+ return Filenames.Comparison'Pos (Sort_Method
+ (Interfaces.C.Strings.Value (A),
+ Interfaces.C.Strings.Value (B))) - 1;
+ end File_Chooser_Sort_Hook;
+
+
+ procedure File_Chooser_Callback_Hook
+ (C_Addr, User_Data : in Storage.Integer_Address);
+
+ pragma Convention (C, File_Chooser_Callback_Hook);
+
+ procedure File_Chooser_Callback_Hook
+ (C_Addr, User_Data : in Storage.Integer_Address)
+ is
+ Ada_Obj : access File_Chooser'Class :=
+ File_Chooser_Convert.To_Pointer (Storage.To_Address (User_Data));
+ begin
+ if Ada_Obj.My_Callback /= null then
+ Ada_Obj.My_Callback (Ada_Obj.all);
+ end if;
+ end File_Chooser_Callback_Hook;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ -- Releasing carrier pigeon
+ procedure fl_button_extra_final
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Import (C, fl_button_extra_final, "fl_button_extra_final");
+ pragma Inline (fl_button_extra_final);
+
+
+ -- Entering wormhole
+ procedure fl_check_button_extra_final
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Import (C, fl_check_button_extra_final, "fl_check_button_extra_final");
+ pragma Inline (fl_check_button_extra_final);
+
+
+ procedure Extra_Final
+ (This : in out File_Chooser)
+ is
+ use Interfaces.C.Strings;
+ begin
+ fl_button_extra_final (Storage.To_Integer (This.New_Butt'Address));
+ fl_check_button_extra_final (Storage.To_Integer (This.Preview_Butt'Address));
+ fl_check_button_extra_final (Storage.To_Integer (This.Hidden_Butt'Address));
+ Free (This.My_Label);
+ Free (This.My_OK_Label);
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out File_Chooser) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_file_chooser (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+ procedure Finalize
+ (This : in out File_Chooser_Final_Controller)
+ is
+ use Interfaces.C.Strings;
+ begin
+ Free (Add_Favorites_Label);
+ Free (All_Files_Label);
+ Free (Custom_Filter_Label);
+ Free (Existing_File_Label);
+ Free (Favorites_Label);
+ Free (Filename_Label);
+ Free (Filesystems_Label);
+ Free (Hidden_Label);
+ Free (Manage_Favorites_Label);
+ Free (New_Directory_Label);
+ Free (New_Directory_Tooltip);
+ Free (Preview_Label);
+ Free (Save_Label);
+ Free (Show_Label);
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ -- Bypassing border checkpoints
+ procedure fl_button_extra_init
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.char_array);
+ pragma Import (C, fl_button_extra_init, "fl_button_extra_init");
+ pragma Inline (fl_button_extra_init);
+
+
+ -- Refracting off language boundaries
+ procedure fl_check_button_extra_init
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.char_array);
+ pragma Import (C, fl_check_button_extra_init, "fl_check_button_extra_init");
+ pragma Inline (fl_check_button_extra_init);
+
+
+ procedure Extra_Init
+ (This : in out File_Chooser) is
+ begin
+ Wrapper (This.New_Butt).Void_Ptr := fl_file_chooser_newbutton (This.Void_Ptr);
+ Wrapper (This.New_Butt).Needs_Dealloc := False;
+ fl_button_extra_init
+ (Storage.To_Integer (This.New_Butt'Address),
+ Interfaces.C.int (This.New_Butt.Get_X),
+ Interfaces.C.int (This.New_Butt.Get_Y),
+ Interfaces.C.int (This.New_Butt.Get_W),
+ Interfaces.C.int (This.New_Butt.Get_H),
+ Interfaces.C.To_C (This.New_Butt.Get_Label));
+
+ Wrapper (This.Preview_Butt).Void_Ptr := fl_file_chooser_previewbutton (This.Void_Ptr);
+ Wrapper (This.Preview_Butt).Needs_Dealloc := False;
+ fl_check_button_extra_init
+ (Storage.To_Integer (This.Preview_Butt'Address),
+ Interfaces.C.int (This.Preview_Butt.Get_X),
+ Interfaces.C.int (This.Preview_Butt.Get_Y),
+ Interfaces.C.int (This.Preview_Butt.Get_W),
+ Interfaces.C.int (This.Preview_Butt.Get_H),
+ Interfaces.C.To_C (This.Preview_Butt.Get_Label));
+
+ Wrapper (This.Hidden_Butt).Void_Ptr := fl_file_chooser_showhiddenbutton (This.Void_Ptr);
+ Wrapper (This.Hidden_Butt).Needs_Dealloc := False;
+ fl_check_button_extra_init
+ (Storage.To_Integer (This.Hidden_Butt'Address),
+ Interfaces.C.int (This.Hidden_Butt.Get_X),
+ Interfaces.C.int (This.Hidden_Butt.Get_Y),
+ Interfaces.C.int (This.Hidden_Butt.Get_W),
+ Interfaces.C.int (This.Hidden_Butt.Get_H),
+ Interfaces.C.To_C (This.Hidden_Butt.Get_Label));
+
+ fl_file_chooser_set_user_data
+ (This.Void_Ptr,
+ Storage.To_Integer (This'Address));
+ fl_file_chooser_callback
+ (This.Void_Ptr,
+ Storage.To_Integer (File_Chooser_Callback_Hook'Address),
+ Storage.To_Integer (This'Address));
+ end Extra_Init;
+
+
+ package body Forge is
+
+ function Create
+ (Title : in String;
+ Pattern : in String;
+ Pathname : in String;
+ Kind : in Chooser_Kind := Single)
+ return File_Chooser is
+ begin
+ return This : File_Chooser do
+ This.Void_Ptr := new_fl_file_chooser
+ (Interfaces.C.To_C (Pathname),
+ Interfaces.C.To_C (Pattern),
+ Chooser_Kind'Pos (Kind),
+ Interfaces.C.To_C (Title));
+ Extra_Init (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ ------------------
+ -- Attributes --
+ ------------------
+
+ function New_Button
+ (This : in out File_Chooser)
+ return FLTK.Widgets.Buttons.Button_Reference is
+ begin
+ return (Data => This.New_Butt'Unchecked_Access);
+ end New_Button;
+
+
+ function Preview_Button
+ (This : in out File_Chooser)
+ return FLTK.Widgets.Buttons.Light.Check.Check_Button_Reference is
+ begin
+ return (Data => This.Preview_Butt'Unchecked_Access);
+ end Preview_Button;
+
+
+ function Show_Hidden_Button
+ (This : in out File_Chooser)
+ return FLTK.Widgets.Buttons.Light.Check.Check_Button_Reference is
+ begin
+ return (Data => This.Hidden_Butt'Unchecked_Access);
+ end Show_Hidden_Button;
+
+
+
+
+ -------------------------
+ -- Static Attributes --
+ -------------------------
+
+ function Get_Add_Favorites_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_add_favorites_label);
+ end Get_Add_Favorites_Label;
+
+
+ procedure Set_Add_Favorites_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Add_Favorites_Label);
+ Add_Favorites_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_add_favorites_label (Add_Favorites_Label);
+ end Set_Add_Favorites_Label;
+
+
+ function Get_All_Files_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_all_files_label);
+ end Get_All_Files_Label;
+
+
+ procedure Set_All_Files_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (All_Files_Label);
+ All_Files_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_all_files_label (All_Files_Label);
+ end Set_All_Files_Label;
+
+
+ function Get_Custom_Filter_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_custom_filter_label);
+ end Get_Custom_Filter_Label;
+
+
+ procedure Set_Custom_Filter_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Custom_Filter_Label);
+ Custom_Filter_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_custom_filter_label (Custom_Filter_Label);
+ end Set_Custom_Filter_Label;
+
+
+ function Get_Existing_File_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_existing_file_label);
+ end Get_Existing_File_Label;
+
+
+ procedure Set_Existing_File_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Existing_File_Label);
+ Existing_File_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_existing_file_label (Existing_File_Label);
+ end Set_Existing_File_Label;
+
+
+ function Get_Favorites_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_favorites_label);
+ end Get_Favorites_Label;
+
+
+ procedure Set_Favorites_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Favorites_Label);
+ Favorites_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_favorites_label (Favorites_Label);
+ end Set_Favorites_Label;
+
+
+ function Get_Filename_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_filename_label);
+ end Get_Filename_Label;
+
+
+ procedure Set_Filename_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Filename_Label);
+ Filename_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_filename_label (Filename_Label);
+ end Set_Filename_Label;
+
+
+ function Get_Filesystems_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_filesystems_label);
+ end Get_Filesystems_Label;
+
+
+ procedure Set_Filesystems_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Filesystems_Label);
+ Filesystems_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_filesystems_label (Filesystems_Label);
+ end Set_Filesystems_Label;
+
+
+ function Get_Hidden_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_hidden_label);
+ end Get_Hidden_Label;
+
+
+ procedure Set_Hidden_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Hidden_Label);
+ Hidden_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_hidden_label (Hidden_Label);
+ end Set_Hidden_Label;
+
+
+ function Get_Manage_Favorites_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_manage_favorites_label);
+ end Get_Manage_Favorites_Label;
+
+
+ procedure Set_Manage_Favorites_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Manage_Favorites_Label);
+ Manage_Favorites_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_manage_favorites_label (Manage_Favorites_Label);
+ end Set_Manage_Favorites_Label;
+
+
+ function Get_New_Directory_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_new_directory_label);
+ end Get_New_Directory_Label;
+
+
+ procedure Set_New_Directory_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (New_Directory_Label);
+ New_Directory_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_new_directory_label (New_Directory_Label);
+ end Set_New_Directory_Label;
+
+
+ function Get_New_Directory_Tooltip
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_new_directory_tooltip);
+ end Get_New_Directory_Tooltip;
+
+
+ procedure Set_New_Directory_Tooltip
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (New_Directory_Tooltip);
+ New_Directory_Tooltip := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_new_directory_tooltip (New_Directory_Tooltip);
+ end Set_New_Directory_Tooltip;
+
+
+ function Get_Preview_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_preview_label);
+ end Get_Preview_Label;
+
+
+ procedure Set_Preview_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Preview_Label);
+ Preview_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_preview_label (Preview_Label);
+ end Set_Preview_Label;
+
+
+ function Get_Save_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_save_label);
+ end Get_Save_Label;
+
+
+ procedure Set_Save_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Save_Label);
+ Save_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_save_label (Save_Label);
+ end Set_Save_Label;
+
+
+ function Get_Show_Label
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_show_label);
+ end Get_Show_Label;
+
+ procedure Set_Show_Label
+ (Value : in String) is
+ begin
+ Interfaces.C.Strings.Free (Show_Label);
+ Show_Label := Interfaces.C.Strings.New_String (Value);
+ fl_file_chooser_set_show_label (Show_Label);
+ end Set_Show_Label;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Add_Extra
+ (This : in out File_Chooser;
+ Item : in out Widgets.Widget'Class)
+ is
+ C_Addr : Storage.Integer_Address;
+ begin
+ C_Addr := fl_file_chooser_add_extra (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+ end Add_Extra;
+
+
+ procedure Remove_Extra
+ (This : in out File_Chooser)
+ is
+ C_Addr : Storage.Integer_Address;
+ begin
+ C_Addr := fl_file_chooser_add_extra (This.Void_Ptr, Null_Pointer);
+ end Remove_Extra;
+
+
+ function Eject_Extra
+ (This : in out File_Chooser;
+ Item : in out Widgets.Widget'Class)
+ return access Widgets.Widget'Class
+ is
+ C_Addr : Storage.Integer_Address :=
+ fl_file_chooser_add_extra (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+ Ada_Obj : access Widgets.Widget'Class;
+ begin
+ if C_Addr /= Null_Pointer then
+ C_Addr := fl_widget_get_user_data (C_Addr);
+ pragma Assert (C_Addr /= Null_Pointer);
+ Ada_Obj := Widget_Convert.To_Pointer (Storage.To_Address (C_Addr));
+ end if;
+ return Ada_Obj;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Eject_Extra;
+
+
+ procedure Set_Callback
+ (This : in out File_Chooser;
+ Func : in Chooser_Callback) is
+ begin
+ This.My_Callback := Func;
+ end Set_Callback;
+
+
+
+
+ function Get_Background_Color
+ (This : in File_Chooser)
+ return Color is
+ begin
+ return Color (fl_file_chooser_get_color (This.Void_Ptr));
+ end Get_Background_Color;
+
+
+ procedure Set_Background_Color
+ (This : in out File_Chooser;
+ Value : in Color) is
+ begin
+ fl_file_chooser_set_color (This.Void_Ptr, Interfaces.C.unsigned (Value));
+ end Set_Background_Color;
+
+
+ function Get_Icon_Size
+ (This : in File_Chooser)
+ return Icon_Size is
+ begin
+ return Icon_Size (fl_file_chooser_get_iconsize (This.Void_Ptr));
+ end Get_Icon_Size;
+
+
+ procedure Set_Icon_Size
+ (This : in out File_Chooser;
+ Value : in Icon_Size) is
+ begin
+ fl_file_chooser_set_iconsize (This.Void_Ptr, Interfaces.C.unsigned_char (Value));
+ end Set_Icon_Size;
+
+
+ function Get_Label
+ (This : in File_Chooser)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_label (This.Void_Ptr));
+ end Get_Label;
+
+
+ procedure Set_Label
+ (This : in out File_Chooser;
+ Text : in String) is
+ begin
+ Interfaces.C.Strings.Free (This.My_Label);
+ This.My_Label := Interfaces.C.Strings.New_String (Text);
+ fl_file_chooser_set_label (This.Void_Ptr, This.My_Label);
+ end Set_Label;
+
+
+ function Get_OK_Label
+ (This : in File_Chooser)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_file_chooser_get_ok_label (This.Void_Ptr));
+ end Get_OK_Label;
+
+
+ procedure Set_OK_Label
+ (This : in out File_Chooser;
+ Text : in String) is
+ begin
+ Interfaces.C.Strings.Free (This.My_OK_Label);
+ This.My_OK_Label := Interfaces.C.Strings.New_String (Text);
+ fl_file_chooser_set_ok_label (This.Void_Ptr, This.My_OK_Label);
+ end Set_OK_Label;
+
+
+ function Has_Preview
+ (This : in File_Chooser)
+ return Boolean
+ is
+ Ret : Interfaces.C.int := fl_file_chooser_get_preview (This.Void_Ptr);
+ begin
+ pragma Assert (Ret in 0 .. 1);
+ return Boolean'Val (Ret);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Has_Preview;
+
+
+ procedure Set_Preview
+ (This : in out File_Chooser;
+ Value : in Boolean) is
+ begin
+ fl_file_chooser_set_preview (This.Void_Ptr, Boolean'Pos (Value));
+ end Set_Preview;
+
+
+ function Get_Text_Color
+ (This : in File_Chooser)
+ return Color is
+ begin
+ return Color (fl_file_chooser_get_textcolor (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out File_Chooser;
+ Value : in Color) is
+ begin
+ fl_file_chooser_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (Value));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in File_Chooser)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_file_chooser_get_textfont (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out File_Chooser;
+ Font : in Font_Kind) is
+ begin
+ fl_file_chooser_set_textfont (This.Void_Ptr, Font_Kind'Pos (Font));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in File_Chooser)
+ return Font_Size is
+ begin
+ return Font_Size (fl_file_chooser_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out File_Chooser;
+ Size : in Font_Size) is
+ begin
+ fl_file_chooser_set_textsize (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Text_Size;
+
+
+ function Get_Kind
+ (This : in File_Chooser)
+ return Chooser_Kind
+ is
+ Ret : Interfaces.C.int := fl_file_chooser_get_type (This.Void_Ptr);
+ begin
+ pragma Assert (Ret in 0 .. Chooser_Kind'Pos (Chooser_Kind'Last));
+ return Chooser_Kind'Val (Ret);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error with
+ "Fl_File_Chooser::type returned unexpected int value of " &
+ Interfaces.C.int'Image (Ret);
+ end Get_Kind;
+
+
+ procedure Set_Kind
+ (This : in out File_Chooser;
+ Kind : in Chooser_Kind) is
+ begin
+ fl_file_chooser_set_type (This.Void_Ptr, Chooser_Kind'Pos (Kind));
+ end Set_Kind;
+
+
+
+
+ function Number_Selected
+ (This : in File_Chooser)
+ return Natural is
+ begin
+ return Natural (fl_file_chooser_count (This.Void_Ptr));
+ end Number_Selected;
+
+
+ function Get_Directory
+ (This : in File_Chooser)
+ return String
+ is
+ C_Ptr : Interfaces.C.Strings.chars_ptr := fl_file_chooser_get_directory (This.Void_Ptr);
+ begin
+ if C_Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (C_Ptr);
+ end if;
+ end Get_Directory;
+
+
+ procedure Set_Directory
+ (This : in out File_Chooser;
+ Value : in String)
+ is
+ use Interfaces.C;
+ C_Arr : aliased char_array := To_C (Value);
+ begin
+ if Value = "" then
+ fl_file_chooser_set_directory (This.Void_Ptr, Strings.Null_Ptr);
+ else
+ fl_file_chooser_set_directory
+ (This.Void_Ptr,
+ Strings.To_Chars_Ptr (C_Arr'Unchecked_Access));
+ end if;
+ end Set_Directory;
+
+
+ function Get_Filter
+ (This : in File_Chooser)
+ return String
+ is
+ C_Ptr : Interfaces.C.Strings.chars_ptr := fl_file_chooser_get_filter (This.Void_Ptr);
+ begin
+ if C_Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (C_Ptr);
+ end if;
+ end Get_Filter;
+
+
+ procedure Set_Filter
+ (This : in out File_Chooser;
+ Value : in String)
+ is
+ use Interfaces.C;
+ C_Arr : aliased char_array := To_C (Value);
+ begin
+ if Value = "" then
+ fl_file_chooser_set_filter (This.Void_Ptr, Strings.Null_Ptr);
+ else
+ fl_file_chooser_set_filter
+ (This.Void_Ptr,
+ Strings.To_Chars_Ptr (C_Arr'Unchecked_Access));
+ end if;
+ end Set_Filter;
+
+
+ function Get_Filter_Index
+ (This : in File_Chooser)
+ return Positive is
+ begin
+ return Positive (fl_file_chooser_get_filter_value (This.Void_Ptr) + 1);
+ end Get_Filter_Index;
+
+
+ procedure Set_Filter_Index
+ (This : in out File_Chooser;
+ Value : in Positive) is
+ begin
+ fl_file_chooser_set_filter_value (This.Void_Ptr, Interfaces.C.int (Value) - 1);
+ end Set_Filter_Index;
+
+
+ procedure Rescan
+ (This : in out File_Chooser) is
+ begin
+ fl_file_chooser_rescan (This.Void_Ptr);
+ end Rescan;
+
+
+ procedure Rescan_Keep_Filename
+ (This : in out File_Chooser) is
+ begin
+ fl_file_chooser_rescan_keep_filename (This.Void_Ptr);
+ end Rescan_Keep_Filename;
+
+
+ function Get_Selected
+ (This : in File_Chooser;
+ Index : in Positive := 1)
+ return String
+ is
+ C_Ptr : Interfaces.C.Strings.chars_ptr :=
+ fl_file_chooser_get_value (This.Void_Ptr, Interfaces.C.int (Index));
+ begin
+ if C_Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (C_Ptr);
+ end if;
+ end Get_Selected;
+
+
+ procedure Set_Selected
+ (This : in out File_Chooser;
+ Value : in String) is
+ begin
+ fl_file_chooser_set_value (This.Void_Ptr, Interfaces.C.To_C (Value));
+ end Set_Selected;
+
+
+
+
+ procedure Show
+ (This : in out File_Chooser) is
+ begin
+ fl_file_chooser_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Hide
+ (This : in out File_Chooser) is
+ begin
+ fl_file_chooser_hide (This.Void_Ptr);
+ end Hide;
+
+
+ function Is_Shown
+ (This : in File_Chooser)
+ return Boolean is
+ begin
+ return fl_file_chooser_shown (This.Void_Ptr) /= 0;
+ end Is_Shown;
+
+
+ function Is_Visible
+ (This : in File_Chooser)
+ return Boolean is
+ begin
+ return fl_file_chooser_visible (This.Void_Ptr) /= 0;
+ end Is_Visible;
+
+
+begin
+
+ file_chooser_setup_sort_hook;
+
+end FLTK.File_Choosers;
+
+
diff --git a/body/fltk-filenames.adb b/body/fltk-filenames.adb
new file mode 100644
index 0000000..7674323
--- /dev/null
+++ b/body/fltk-filenames.adb
@@ -0,0 +1,492 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Filenames is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Constants From C --
+ ------------------------
+
+ error_bsize : constant Interfaces.C.int;
+ pragma Import (C, error_bsize, "error_bsize");
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ procedure free_filename_file_list
+ (L : in Storage.Integer_Address;
+ N : in Interfaces.C.int);
+ pragma Import (C, free_filename_file_list, "free_filename_file_list");
+ pragma Inline (free_filename_file_list);
+
+ function filename_dname
+ (L : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, filename_dname, "filename_dname");
+ pragma Inline (filename_dname);
+
+
+
+
+ procedure filename_decode_uri
+ (URI : in Interfaces.C.char_array);
+ pragma Import (C, filename_decode_uri, "filename_decode_uri");
+ pragma Inline (filename_decode_uri);
+
+ function filename_absolute
+ (To : in Interfaces.C.char_array;
+ Len : in Interfaces.C.int;
+ From : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, filename_absolute, "filename_absolute");
+ pragma Inline (filename_absolute);
+
+ function filename_expand
+ (To : in Interfaces.C.char_array;
+ Len : in Interfaces.C.int;
+ From : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, filename_expand, "filename_expand");
+ pragma Inline (filename_expand);
+
+ function filename_ext
+ (Buf : in Interfaces.C.char_array)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, filename_ext, "filename_ext");
+ pragma Inline (filename_ext);
+
+ function filename_isdir
+ (Name : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, filename_isdir, "filename_isdir");
+ pragma Inline (filename_isdir);
+
+ function filename_list
+ (D : in Interfaces.C.char_array;
+ L : out Storage.Integer_Address;
+ F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, filename_list, "filename_list");
+ pragma Inline (filename_list);
+
+ function filename_match
+ (Name, Pattern : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, filename_match, "filename_match");
+ pragma Inline (filename_match);
+
+ function filename_name
+ (Name : in Interfaces.C.char_array)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, filename_name, "filename_name");
+ pragma Inline (filename_name);
+
+ function filename_relative
+ (To : in Interfaces.C.char_array;
+ Len : in Interfaces.C.int;
+ From : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, filename_relative, "filename_relative");
+ pragma Inline (filename_relative);
+
+ function filename_setext
+ (To : in Interfaces.C.char_array;
+ Len : in Interfaces.C.int;
+ Ext : in Interfaces.C.char_array)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, filename_setext, "filename_setext");
+ pragma Inline (filename_setext);
+
+ function filename_open_uri
+ (U, M : in Interfaces.C.char_array;
+ Len : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, filename_open_uri, "filename_open_uri");
+ pragma Inline (filename_open_uri);
+
+
+
+
+ function filename_alphasort
+ (A, B : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, filename_alphasort, "filename_alphasort");
+
+ function filename_casealphasort
+ (A, B : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, filename_casealphasort, "filename_casealphasort");
+
+ function filename_numericsort
+ (A, B : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, filename_numericsort, "filename_numericsort");
+
+ function filename_casenumericsort
+ (A, B : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, filename_casenumericsort, "filename_casenumericsort");
+
+
+
+
+ ------------------------------
+ -- Comparison Subprograms --
+ ------------------------------
+
+ function Alpha_Sort
+ (A, B : in String)
+ return Comparison
+ is
+ Result : Interfaces.C.int :=
+ filename_alphasort (Interfaces.C.To_C (A), Interfaces.C.To_C (B));
+ begin
+ pragma Assert
+ (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last));
+ return Comparison'Val (Result);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Alpha_Sort;
+
+
+ function Case_Alpha_Sort
+ (A, B : in String)
+ return Comparison
+ is
+ Result : Interfaces.C.int :=
+ filename_casealphasort (Interfaces.C.To_C (A), Interfaces.C.To_C (B));
+ begin
+ pragma Assert
+ (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last));
+ return Comparison'Val (Result);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Case_Alpha_Sort;
+
+
+ function Numeric_Sort
+ (A, B : in String)
+ return Comparison
+ is
+ Result : Interfaces.C.int :=
+ filename_numericsort (Interfaces.C.To_C (A), Interfaces.C.To_C (B));
+ begin
+ pragma Assert
+ (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last));
+ return Comparison'Val (Result);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Numeric_Sort;
+
+
+ function Case_Numeric_Sort
+ (A, B : in String)
+ return Comparison
+ is
+ Result : Interfaces.C.int :=
+ filename_casenumericsort (Interfaces.C.To_C (A), Interfaces.C.To_C (B));
+ begin
+ pragma Assert
+ (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last));
+ return Comparison'Val (Result);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Case_Numeric_Sort;
+
+
+
+
+ ---------------------------
+ -- Listing Subprograms --
+ ---------------------------
+
+ procedure Finalize
+ (This : in out File_List) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_filename_file_list (This.Void_Ptr, This.Entries);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+ function Length
+ (This : in File_List)
+ return Natural is
+ begin
+ return Natural (This.Entries);
+ end Length;
+
+
+ function Item
+ (This : in File_List;
+ Index : in Positive)
+ return Path_String is
+ begin
+ return Interfaces.C.Strings.Value
+ (filename_dname (This.Void_Ptr, Interfaces.C.int (Index) - 1));
+ end Item;
+
+
+
+
+ --------------------
+ -- Filename API --
+ --------------------
+
+ function Decode_URI
+ (URI : in Path_String)
+ return Path_String
+ is
+ C_Ptr : Interfaces.C.char_array := Interfaces.C.To_C (URI);
+ begin
+ filename_decode_uri (C_Ptr);
+ return Interfaces.C.To_Ada (C_Ptr);
+ end Decode_URI;
+
+
+ procedure Open_URI
+ (URI : in Path_String)
+ is
+ Message : Interfaces.C.char_array (1 .. Interfaces.C.size_t (error_bsize)) :=
+ (others => Interfaces.C.char'Val (0));
+ Result : Interfaces.C.int := filename_open_uri
+ (Interfaces.C.To_C (URI),
+ Message,
+ error_bsize);
+ begin
+ if Result = 0 then
+ raise Open_URI_Error with "Error: " & Interfaces.C.To_Ada (Message);
+ else
+ pragma Assert (Result = 1);
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Open_URI;
+
+
+
+
+ function Absolute
+ (Name : in Path_String)
+ return Path_String
+ is
+ Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) :=
+ (others => Interfaces.C.char'Val (0));
+ Code : Interfaces.C.int := filename_absolute
+ (Result,
+ Interfaces.C.int (Max_Path_Length),
+ Interfaces.C.To_C (Name));
+ begin
+ return Interfaces.C.To_Ada (Result);
+ end Absolute;
+
+
+ function Absolute
+ (Name : in Path_String;
+ Changed : out Boolean)
+ return Path_String
+ is
+ Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) :=
+ (others => Interfaces.C.char'Val (0));
+ Code : Interfaces.C.int := filename_absolute
+ (Result,
+ Interfaces.C.int (Max_Path_Length),
+ Interfaces.C.To_C (Name));
+ begin
+ Changed := Code /= 0;
+ return Interfaces.C.To_Ada (Result);
+ end Absolute;
+
+
+ function Relative
+ (Name : in Path_String)
+ return Path_String
+ is
+ Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) :=
+ (others => Interfaces.C.char'Val (0));
+ Code : Interfaces.C.int := filename_relative
+ (Result,
+ Interfaces.C.int (Max_Path_Length),
+ Interfaces.C.To_C (Name));
+ begin
+ return Interfaces.C.To_Ada (Result);
+ end Relative;
+
+
+ function Relative
+ (Name : in Path_String;
+ Changed : out Boolean)
+ return Path_String
+ is
+ Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) :=
+ (others => Interfaces.C.char'Val (0));
+ Code : Interfaces.C.int := filename_relative
+ (Result,
+ Interfaces.C.int (Max_Path_Length),
+ Interfaces.C.To_C (Name));
+ begin
+ Changed := Code /= 0;
+ return Interfaces.C.To_Ada (Result);
+ end Relative;
+
+
+ function Expand
+ (Name : in Path_String)
+ return Path_String
+ is
+ Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) :=
+ (others => Interfaces.C.char'Val (0));
+ Code : Interfaces.C.int := filename_expand
+ (Result,
+ Interfaces.C.int (Max_Path_Length),
+ Interfaces.C.To_C (Name));
+ begin
+ return Interfaces.C.To_Ada (Result);
+ end Expand;
+
+
+ function Expand
+ (Name : in Path_String;
+ Changed : out Boolean)
+ return Path_String
+ is
+ Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) :=
+ (others => Interfaces.C.char'Val (0));
+ Code : Interfaces.C.int := filename_expand
+ (Result,
+ Interfaces.C.int (Max_Path_Length),
+ Interfaces.C.To_C (Name));
+ begin
+ Changed := Code /= 0;
+ return Interfaces.C.To_Ada (Result);
+ end Expand;
+
+
+
+
+ function Base_Name
+ (Name : in Path_String)
+ return Path_String
+ is
+ Data : Interfaces.C.char_array := Interfaces.C.To_C (Name);
+ begin
+ return Interfaces.C.Strings.Value (filename_name (Data));
+ end Base_Name;
+
+
+ function Extension
+ (Name : in Path_String)
+ return Path_String
+ is
+ Data : Interfaces.C.char_array := Interfaces.C.To_C (Name);
+ Result : Interfaces.C.Strings.chars_ptr := filename_ext (Data);
+ begin
+ if Result = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Result);
+ end if;
+ end Extension;
+
+
+ function Set_Extension
+ (Name : in Path_String;
+ Suffix : in String)
+ return Path_String
+ is
+ Data : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) :=
+ (others => Interfaces.C.char'Val (0));
+ Result : Interfaces.C.Strings.chars_ptr;
+ begin
+ Data (1 .. Name'Length) := Interfaces.C.To_C (Name);
+ Result := filename_setext
+ (Data,
+ Data'Length,
+ Interfaces.C.To_C (Suffix));
+ return Interfaces.C.Strings.Value (Result);
+ end Set_Extension;
+
+
+
+
+ function Is_Directory
+ (Name : in Path_String)
+ return Boolean is
+ begin
+ return filename_isdir (Interfaces.C.To_C (Name)) /= 0;
+ end Is_Directory;
+
+
+ Current_Sort : Compare_Function;
+
+ function Compare_Hook
+ (DA, DB : in Storage.Integer_Address)
+ return Interfaces.C.int;
+
+ pragma Convention (C, Compare_Hook);
+
+ function Compare_Hook
+ (DA, DB : in Storage.Integer_Address)
+ return Interfaces.C.int
+ is
+ Result : Comparison := Current_Sort
+ (Interfaces.C.Strings.Value (filename_dname (DA, 0)),
+ Interfaces.C.Strings.Value (filename_dname (DB, 0)));
+ begin
+ return Comparison'Pos (Result) - 1;
+ end Compare_Hook;
+
+ function Get_Listing
+ (Name : in Path_String;
+ Sort : in not null Compare_Function := Numeric_Sort'Access)
+ return File_List is
+ begin
+ Current_Sort := Sort;
+ return This : File_List do
+ This.Entries := filename_list
+ (Interfaces.C.To_C (Name),
+ This.Void_Ptr,
+ Storage.To_Integer (Compare_Hook'Address));
+ end return;
+ end Get_Listing;
+
+
+
+
+ function Match
+ (Input, Pattern : in String)
+ return Boolean is
+ begin
+ return filename_match (Interfaces.C.To_C (Input), Interfaces.C.To_C (Pattern)) /= 0;
+ end Match;
+
+
+end FLTK.Filenames;
+
+
diff --git a/body/fltk-help_dialogs.adb b/body/fltk-help_dialogs.adb
new file mode 100644
index 0000000..fc5ab07
--- /dev/null
+++ b/body/fltk-help_dialogs.adb
@@ -0,0 +1,361 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Show_Argv,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Help_Dialogs is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_help_dialog
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_help_dialog, "new_fl_help_dialog");
+ pragma Inline (new_fl_help_dialog);
+
+ procedure free_fl_help_dialog
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_help_dialog, "free_fl_help_dialog");
+ pragma Inline (free_fl_help_dialog);
+
+
+
+
+ procedure fl_help_dialog_show
+ (D : in Storage.Integer_Address);
+ pragma Import (C, fl_help_dialog_show, "fl_help_dialog_show");
+ pragma Inline (fl_help_dialog_show);
+
+ procedure fl_help_dialog_show2
+ (D : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ V : in Storage.Integer_Address);
+ pragma Import (C, fl_help_dialog_show2, "fl_help_dialog_show2");
+ pragma Inline (fl_help_dialog_show2);
+
+ procedure fl_help_dialog_hide
+ (D : in Storage.Integer_Address);
+ pragma Import (C, fl_help_dialog_hide, "fl_help_dialog_hide");
+ pragma Inline (fl_help_dialog_hide);
+
+ function fl_help_dialog_visible
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_dialog_visible, "fl_help_dialog_visible");
+ pragma Inline (fl_help_dialog_visible);
+
+
+
+
+ procedure fl_help_dialog_set_topline_number
+ (D : in Storage.Integer_Address;
+ N : in Interfaces.C.int);
+ pragma Import (C, fl_help_dialog_set_topline_number, "fl_help_dialog_set_topline_number");
+ pragma Inline (fl_help_dialog_set_topline_number);
+
+ procedure fl_help_dialog_set_topline_target
+ (D : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_help_dialog_set_topline_target, "fl_help_dialog_set_topline_target");
+ pragma Inline (fl_help_dialog_set_topline_target);
+
+
+
+
+ procedure fl_help_dialog_load
+ (D : in Storage.Integer_Address;
+ N : in Interfaces.C.char_array);
+ pragma Import (C, fl_help_dialog_load, "fl_help_dialog_load");
+ pragma Inline (fl_help_dialog_load);
+
+ function fl_help_dialog_get_value
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_help_dialog_get_value, "fl_help_dialog_get_value");
+ pragma Inline (fl_help_dialog_get_value);
+
+ procedure fl_help_dialog_set_value
+ (D : in Storage.Integer_Address;
+ V : in Interfaces.C.char_array);
+ pragma Import (C, fl_help_dialog_set_value, "fl_help_dialog_set_value");
+ pragma Inline (fl_help_dialog_set_value);
+
+
+
+
+ function fl_help_dialog_get_textsize
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_dialog_get_textsize, "fl_help_dialog_get_textsize");
+ pragma Inline (fl_help_dialog_get_textsize);
+
+ procedure fl_help_dialog_set_textsize
+ (D : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_help_dialog_set_textsize, "fl_help_dialog_set_textsize");
+ pragma Inline (fl_help_dialog_set_textsize);
+
+
+
+
+ function fl_help_dialog_get_x
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_dialog_get_x, "fl_help_dialog_get_x");
+ pragma Inline (fl_help_dialog_get_x);
+
+ function fl_help_dialog_get_y
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_dialog_get_y, "fl_help_dialog_get_y");
+ pragma Inline (fl_help_dialog_get_y);
+
+ function fl_help_dialog_get_w
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_dialog_get_w, "fl_help_dialog_get_w");
+ pragma Inline (fl_help_dialog_get_w);
+
+ function fl_help_dialog_get_h
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_dialog_get_h, "fl_help_dialog_get_h");
+ pragma Inline (fl_help_dialog_get_h);
+
+ procedure fl_help_dialog_resize
+ (D : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_help_dialog_resize, "fl_help_dialog_resize");
+ pragma Inline (fl_help_dialog_resize);
+
+ procedure fl_help_dialog_position
+ (D : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_help_dialog_position, "fl_help_dialog_position");
+ pragma Inline (fl_help_dialog_position);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Finalize
+ (This : in out Help_Dialog) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_help_dialog (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ return Help_Dialog is
+ begin
+ return This : Help_Dialog do
+ This.Void_Ptr := new_fl_help_dialog;
+ end return;
+ end Create;
+
+
+ function Create
+ (X, Y, W, H : in Integer)
+ return Help_Dialog is
+ begin
+ return This : Help_Dialog do
+ This.Void_Ptr := new_fl_help_dialog;
+ This.Resize (X, Y, W, H);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Show
+ (This : in out Help_Dialog) is
+ begin
+ fl_help_dialog_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Show_With_Args
+ (This : in out Help_Dialog) is
+ begin
+ FLTK.Show_Argv.Dispatch (fl_help_dialog_show2'Access, This.Void_Ptr);
+ end Show_With_Args;
+
+
+ procedure Hide
+ (This : in out Help_Dialog) is
+ begin
+ fl_help_dialog_hide (This.Void_Ptr);
+ end Hide;
+
+
+ function Is_Visible
+ (This : in Help_Dialog)
+ return Boolean is
+ begin
+ return fl_help_dialog_visible (This.Void_Ptr) = 1;
+ end Is_Visible;
+
+
+
+
+ procedure Set_Topline_Number
+ (This : in out Help_Dialog;
+ Line : in Positive) is
+ begin
+ fl_help_dialog_set_topline_number (This.Void_Ptr, Interfaces.C.int (Line) - 1);
+ end Set_Topline_Number;
+
+
+ procedure Set_Topline_Target
+ (This : in out Help_Dialog;
+ Value : in String) is
+ begin
+ fl_help_dialog_set_topline_target (This.Void_Ptr, Interfaces.C.To_C (Value));
+ end Set_Topline_Target;
+
+
+
+
+ procedure Load
+ (This : in out Help_Dialog;
+ Name : in String) is
+ begin
+ fl_help_dialog_load (This.Void_Ptr, Interfaces.C.To_C (Name));
+ end Load;
+
+
+ function Get_Content
+ (This : in Help_Dialog)
+ return String
+ is
+ Raw_Chars : Interfaces.C.Strings.chars_ptr := fl_help_dialog_get_value (This.Void_Ptr);
+ use type Interfaces.C.Strings.chars_ptr;
+ begin
+ if Raw_Chars = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Raw_Chars);
+ end if;
+ end Get_Content;
+
+
+ procedure Set_Content
+ (This : in out Help_Dialog;
+ Value : in String) is
+ begin
+ fl_help_dialog_set_value (This.Void_Ptr, Interfaces.C.To_C (Value));
+ end Set_Content;
+
+
+
+
+ function Get_Text_Size
+ (This : in Help_Dialog)
+ return Font_Size is
+ begin
+ return Font_Size (fl_help_dialog_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Help_Dialog;
+ Size : in Font_Size) is
+ begin
+ fl_help_dialog_set_textsize (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Text_Size;
+
+
+
+
+ function Get_X
+ (This : in Help_Dialog)
+ return Integer is
+ begin
+ return Integer (fl_help_dialog_get_x (This.Void_Ptr));
+ end Get_X;
+
+
+ function Get_Y
+ (This : in Help_Dialog)
+ return Integer is
+ begin
+ return Integer (fl_help_dialog_get_y (This.Void_Ptr));
+ end Get_Y;
+
+
+ function Get_W
+ (This : in Help_Dialog)
+ return Integer is
+ begin
+ return Integer (fl_help_dialog_get_w (This.Void_Ptr));
+ end Get_W;
+
+
+ function Get_H
+ (This : in Help_Dialog)
+ return Integer is
+ begin
+ return Integer (fl_help_dialog_get_h (This.Void_Ptr));
+ end Get_H;
+
+
+ procedure Resize
+ (This : in out Help_Dialog;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_help_dialog_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+ procedure Reposition
+ (This : in out Help_Dialog;
+ X, Y : in Integer) is
+ begin
+ fl_help_dialog_position
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Reposition;
+
+
+end FLTK.Help_Dialogs;
+
+
diff --git a/body/fltk-images-bitmaps-xbm.adb b/body/fltk-images-bitmaps-xbm.adb
new file mode 100644
index 0000000..eb8c093
--- /dev/null
+++ b/body/fltk-images-bitmaps-xbm.adb
@@ -0,0 +1,72 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Images.Bitmaps.XBM is
+
+
+ function new_fl_xbm_image
+ (F : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_xbm_image, "new_fl_xbm_image");
+ pragma Inline (new_fl_xbm_image);
+
+ procedure free_fl_xbm_image
+ (P : in Storage.Integer_Address);
+ pragma Import (C, free_fl_xbm_image, "free_fl_xbm_image");
+ pragma Inline (free_fl_xbm_image);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out XBM_Image) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_xbm_image (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (Filename : in String)
+ return XBM_Image is
+ begin
+ return This : XBM_Image do
+ This.Void_Ptr := new_fl_xbm_image
+ (Interfaces.C.To_C (Filename));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 =>
+ -- raise No_Image_Error;
+ null;
+ -- Since the image depth and line data are both zero here,
+ -- the fail method will think there's no image even though
+ -- nothing is wrong. This is a bug in FLTK.
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Images.Bitmaps.XBM;
+
diff --git a/body/fltk-images-bitmaps.adb b/body/fltk-images-bitmaps.adb
new file mode 100644
index 0000000..90150c9
--- /dev/null
+++ b/body/fltk-images-bitmaps.adb
@@ -0,0 +1,181 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Images.Bitmaps is
+
+
+ function new_fl_bitmap
+ (D : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_bitmap, "new_fl_bitmap");
+ pragma Inline (new_fl_bitmap);
+
+ procedure free_fl_bitmap
+ (I : in Storage.Integer_Address);
+ pragma Import (C, free_fl_bitmap, "free_fl_bitmap");
+ pragma Inline (free_fl_bitmap);
+
+ function fl_bitmap_copy
+ (I : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_bitmap_copy, "fl_bitmap_copy");
+ pragma Inline (fl_bitmap_copy);
+
+ function fl_bitmap_copy2
+ (I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_bitmap_copy2, "fl_bitmap_copy2");
+ pragma Inline (fl_bitmap_copy2);
+
+
+
+
+ procedure fl_bitmap_uncache
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_bitmap_uncache, "fl_bitmap_uncache");
+ pragma Inline (fl_bitmap_uncache);
+
+
+
+
+ procedure fl_bitmap_draw2
+ (I : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_bitmap_draw2, "fl_bitmap_draw2");
+ pragma Inline (fl_bitmap_draw2);
+
+ procedure fl_bitmap_draw
+ (I : in Storage.Integer_Address;
+ X, Y, W, H, CX, CY : in Interfaces.C.int);
+ pragma Import (C, fl_bitmap_draw, "fl_bitmap_draw");
+ pragma Inline (fl_bitmap_draw);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out Bitmap) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_bitmap (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (Data : in Color_Component_Array;
+ Width, Height : in Natural)
+ return Bitmap is
+ begin
+ return This : Bitmap do
+ This.Void_Ptr := new_fl_bitmap
+ (Storage.To_Integer (Data (Data'First)'Address),
+ Interfaces.C.int (Width),
+ Interfaces.C.int (Height));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 =>
+ -- raise No_Image_Error;
+ null;
+ -- Since the image depth and line data are both zero here,
+ -- the fail method will think there's no image even though
+ -- nothing is wrong. This is a bug in FLTK.
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+ function Copy
+ (This : in Bitmap;
+ Width, Height : in Natural)
+ return Bitmap'Class is
+ begin
+ return Copied : Bitmap do
+ Copied.Void_Ptr := fl_bitmap_copy
+ (This.Void_Ptr,
+ Interfaces.C.int (Width),
+ Interfaces.C.int (Height));
+ end return;
+ end Copy;
+
+
+ function Copy
+ (This : in Bitmap)
+ return Bitmap'Class is
+ begin
+ return Copied : Bitmap do
+ Copied.Void_Ptr := fl_bitmap_copy2 (This.Void_Ptr);
+ end return;
+ end Copy;
+
+
+
+
+ ----------------
+ -- Activity --
+ ----------------
+
+ procedure Uncache
+ (This : in out Bitmap) is
+ begin
+ fl_bitmap_uncache (This.Void_Ptr);
+ end Uncache;
+
+
+
+ ---------------
+ -- Drawing --
+ ---------------
+
+ procedure Draw
+ (This : in Bitmap;
+ X, Y : in Integer) is
+ begin
+ fl_bitmap_draw2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Draw;
+
+
+ procedure Draw
+ (This : in Bitmap;
+ X, Y, W, H : in Integer;
+ CX, CY : in Integer := 0) is
+ begin
+ fl_bitmap_draw
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (CX),
+ Interfaces.C.int (CY));
+ end Draw;
+
+
+end FLTK.Images.Bitmaps;
+
diff --git a/body/fltk-images-pixmaps-gif.adb b/body/fltk-images-pixmaps-gif.adb
new file mode 100644
index 0000000..535debf
--- /dev/null
+++ b/body/fltk-images-pixmaps-gif.adb
@@ -0,0 +1,67 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Images.Pixmaps.GIF is
+
+
+ function new_fl_gif_image
+ (F : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_gif_image, "new_fl_gif_image");
+ pragma Inline (new_fl_gif_image);
+
+ procedure free_fl_gif_image
+ (P : in Storage.Integer_Address);
+ pragma Import (C, free_fl_gif_image, "free_fl_gif_image");
+ pragma Inline (free_fl_gif_image);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out GIF_Image) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_gif_image (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (Filename : in String)
+ return GIF_Image is
+ begin
+ return This : GIF_Image do
+ This.Void_Ptr := new_fl_gif_image
+ (Interfaces.C.To_C (Filename));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 => raise No_Image_Error;
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Images.Pixmaps.GIF;
+
diff --git a/body/fltk-images-pixmaps-xpm.adb b/body/fltk-images-pixmaps-xpm.adb
new file mode 100644
index 0000000..006c8b4
--- /dev/null
+++ b/body/fltk-images-pixmaps-xpm.adb
@@ -0,0 +1,67 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Images.Pixmaps.XPM is
+
+
+ function new_fl_xpm_image
+ (F : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_xpm_image, "new_fl_xpm_image");
+ pragma Inline (new_fl_xpm_image);
+
+ procedure free_fl_xpm_image
+ (P : in Storage.Integer_Address);
+ pragma Import (C, free_fl_xpm_image, "free_fl_xpm_image");
+ pragma Inline (free_fl_xpm_image);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out XPM_Image) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_xpm_image (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (Filename : in String)
+ return XPM_Image is
+ begin
+ return This : XPM_Image do
+ This.Void_Ptr := new_fl_xpm_image
+ (Interfaces.C.To_C (Filename));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 => raise No_Image_Error;
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Images.Pixmaps.XPM;
+
diff --git a/body/fltk-images-pixmaps.adb b/body/fltk-images-pixmaps.adb
new file mode 100644
index 0000000..2e66d2f
--- /dev/null
+++ b/body/fltk-images-pixmaps.adb
@@ -0,0 +1,186 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Images.Pixmaps is
+
+
+ procedure free_fl_pixmap
+ (I : in Storage.Integer_Address);
+ pragma Import (C, free_fl_pixmap, "free_fl_pixmap");
+ pragma Inline (free_fl_pixmap);
+
+ function fl_pixmap_copy
+ (I : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_pixmap_copy, "fl_pixmap_copy");
+ pragma Inline (fl_pixmap_copy);
+
+ function fl_pixmap_copy2
+ (I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_pixmap_copy2, "fl_pixmap_copy2");
+ pragma Inline (fl_pixmap_copy2);
+
+
+
+
+ procedure fl_pixmap_color_average
+ (I : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ B : in Interfaces.C.C_float);
+ pragma Import (C, fl_pixmap_color_average, "fl_pixmap_color_average");
+ pragma Inline (fl_pixmap_color_average);
+
+ procedure fl_pixmap_desaturate
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_pixmap_desaturate, "fl_pixmap_desaturate");
+ pragma Inline (fl_pixmap_desaturate);
+
+
+
+
+ procedure fl_pixmap_uncache
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_pixmap_uncache, "fl_pixmap_uncache");
+ pragma Inline (fl_pixmap_uncache);
+
+
+
+
+ procedure fl_pixmap_draw2
+ (I : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_pixmap_draw2, "fl_pixmap_draw2");
+ pragma Inline (fl_pixmap_draw2);
+
+ procedure fl_pixmap_draw
+ (I : in Storage.Integer_Address;
+ X, Y, W, H, CX, CY : in Interfaces.C.int);
+ pragma Import (C, fl_pixmap_draw, "fl_pixmap_draw");
+ pragma Inline (fl_pixmap_draw);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out Pixmap) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_pixmap (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ function Copy
+ (This : in Pixmap;
+ Width, Height : in Natural)
+ return Pixmap'Class is
+ begin
+ return Copied : Pixmap do
+ Copied.Void_Ptr := fl_pixmap_copy
+ (This.Void_Ptr,
+ Interfaces.C.int (Width),
+ Interfaces.C.int (Height));
+ end return;
+ end Copy;
+
+
+ function Copy
+ (This : in Pixmap)
+ return Pixmap'Class is
+ begin
+ return Copied : Pixmap do
+ Copied.Void_Ptr := fl_pixmap_copy2 (This.Void_Ptr);
+ end return;
+ end Copy;
+
+
+
+
+ --------------
+ -- Colors --
+ --------------
+
+ procedure Color_Average
+ (This : in out Pixmap;
+ Col : in Color;
+ Amount : in Blend) is
+ begin
+ fl_pixmap_color_average
+ (This.Void_Ptr,
+ Interfaces.C.int (Col),
+ Interfaces.C.C_float (Amount));
+ end Color_Average;
+
+
+ procedure Desaturate
+ (This : in out Pixmap) is
+ begin
+ fl_pixmap_desaturate (This.Void_Ptr);
+ end Desaturate;
+
+
+
+
+ ----------------
+ -- Activity --
+ ----------------
+
+ procedure Uncache
+ (This : in out Pixmap) is
+ begin
+ fl_pixmap_uncache (This.Void_Ptr);
+ end Uncache;
+
+
+
+
+ ---------------
+ -- Drawing --
+ ---------------
+
+ procedure Draw
+ (This : in Pixmap;
+ X, Y : in Integer) is
+ begin
+ fl_pixmap_draw2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Draw;
+
+
+ procedure Draw
+ (This : in Pixmap;
+ X, Y, W, H : in Integer;
+ CX, CY : in Integer := 0) is
+ begin
+ fl_pixmap_draw
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (CX),
+ Interfaces.C.int (CY));
+ end Draw;
+
+
+end FLTK.Images.Pixmaps;
+
diff --git a/body/fltk-images-rgb-bmp.adb b/body/fltk-images-rgb-bmp.adb
new file mode 100644
index 0000000..01669eb
--- /dev/null
+++ b/body/fltk-images-rgb-bmp.adb
@@ -0,0 +1,67 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Images.RGB.BMP is
+
+
+ function new_fl_bmp_image
+ (F : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_bmp_image, "new_fl_bmp_image");
+ pragma Inline (new_fl_bmp_image);
+
+ procedure free_fl_bmp_image
+ (P : in Storage.Integer_Address);
+ pragma Import (C, free_fl_bmp_image, "free_fl_bmp_image");
+ pragma Inline (free_fl_bmp_image);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out BMP_Image) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_bmp_image (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (Filename : in String)
+ return BMP_Image is
+ begin
+ return This : BMP_Image do
+ This.Void_Ptr := new_fl_bmp_image
+ (Interfaces.C.To_C (Filename));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 => raise No_Image_Error;
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Images.RGB.BMP;
+
diff --git a/body/fltk-images-rgb-jpeg.adb b/body/fltk-images-rgb-jpeg.adb
new file mode 100644
index 0000000..17debb5
--- /dev/null
+++ b/body/fltk-images-rgb-jpeg.adb
@@ -0,0 +1,92 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Images.RGB.JPEG is
+
+
+ function new_fl_jpeg_image
+ (F : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_jpeg_image, "new_fl_jpeg_image");
+ pragma Inline (new_fl_jpeg_image);
+
+ function new_fl_jpeg_image2
+ (N : in Interfaces.C.char_array;
+ D : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_jpeg_image2, "new_fl_jpeg_image2");
+ pragma Inline (new_fl_jpeg_image2);
+
+ procedure free_fl_jpeg_image
+ (P : in Storage.Integer_Address);
+ pragma Import (C, free_fl_jpeg_image, "free_fl_jpeg_image");
+ pragma Inline (free_fl_jpeg_image);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out JPEG_Image) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_jpeg_image (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (Filename : in String)
+ return JPEG_Image is
+ begin
+ return This : JPEG_Image do
+ This.Void_Ptr := new_fl_jpeg_image
+ (Interfaces.C.To_C (Filename));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 => raise No_Image_Error;
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ function Create
+ (Name : in String := "";
+ Data : in Color_Component_Array)
+ return JPEG_Image is
+ begin
+ return This : JPEG_Image do
+ This.Void_Ptr := new_fl_jpeg_image2
+ (Interfaces.C.To_C (Name),
+ Storage.To_Integer (Data (Data'First)'Address));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 => raise No_Image_Error;
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Images.RGB.JPEG;
+
diff --git a/body/fltk-images-rgb-png.adb b/body/fltk-images-rgb-png.adb
new file mode 100644
index 0000000..67befe3
--- /dev/null
+++ b/body/fltk-images-rgb-png.adb
@@ -0,0 +1,94 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Images.RGB.PNG is
+
+
+ function new_fl_png_image
+ (F : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_png_image, "new_fl_png_image");
+ pragma Inline (new_fl_png_image);
+
+ function new_fl_png_image2
+ (N : in Interfaces.C.char_array;
+ D : in Storage.Integer_Address;
+ S : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_png_image2, "new_fl_png_image2");
+ pragma Inline (new_fl_png_image2);
+
+ procedure free_fl_png_image
+ (P : in Storage.Integer_Address);
+ pragma Import (C, free_fl_png_image, "free_fl_png_image");
+ pragma Inline (free_fl_png_image);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out PNG_Image) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_png_image (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ 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));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 => raise No_Image_Error;
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ function Create
+ (Name : in String := "";
+ Data : in Color_Component_Array)
+ return PNG_Image is
+ begin
+ return This : PNG_Image do
+ This.Void_Ptr := new_fl_png_image2
+ (Interfaces.C.To_C (Name),
+ Storage.To_Integer (Data (Data'First)'Address),
+ Data'Length);
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 => raise No_Image_Error;
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Images.RGB.PNG;
+
diff --git a/body/fltk-images-rgb-pnm.adb b/body/fltk-images-rgb-pnm.adb
new file mode 100644
index 0000000..362b8d6
--- /dev/null
+++ b/body/fltk-images-rgb-pnm.adb
@@ -0,0 +1,67 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Images.RGB.PNM is
+
+
+ function new_fl_pnm_image
+ (F : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_pnm_image, "new_fl_pnm_image");
+ pragma Inline (new_fl_pnm_image);
+
+ procedure free_fl_pnm_image
+ (P : in Storage.Integer_Address);
+ pragma Import (C, free_fl_pnm_image, "free_fl_pnm_image");
+ pragma Inline (free_fl_pnm_image);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out PNM_Image) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_pnm_image (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (Filename : in String)
+ return PNM_Image is
+ begin
+ return This : PNM_Image do
+ This.Void_Ptr := new_fl_pnm_image
+ (Interfaces.C.To_C (Filename));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 => raise No_Image_Error;
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Images.RGB.PNM;
+
diff --git a/body/fltk-images-rgb.adb b/body/fltk-images-rgb.adb
new file mode 100644
index 0000000..19a7952
--- /dev/null
+++ b/body/fltk-images-rgb.adb
@@ -0,0 +1,270 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Images.RGB is
+
+
+ function new_fl_rgb_image
+ (Data : in Storage.Integer_Address;
+ W, H, D, L : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_rgb_image, "new_fl_rgb_image");
+ pragma Inline (new_fl_rgb_image);
+
+ function new_fl_rgb_image2
+ (P : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_rgb_image2, "new_fl_rgb_image2");
+ pragma Inline (new_fl_rgb_image2);
+
+ procedure free_fl_rgb_image
+ (I : in Storage.Integer_Address);
+ pragma Import (C, free_fl_rgb_image, "free_fl_rgb_image");
+ pragma Inline (free_fl_rgb_image);
+
+ function fl_rgb_image_get_max_size
+ return Interfaces.C.size_t;
+ pragma Import (C, fl_rgb_image_get_max_size, "fl_rgb_image_get_max_size");
+ pragma Inline (fl_rgb_image_get_max_size);
+
+ procedure fl_rgb_image_set_max_size
+ (V : in Interfaces.C.size_t);
+ pragma Import (C, fl_rgb_image_set_max_size, "fl_rgb_image_set_max_size");
+ pragma Inline (fl_rgb_image_set_max_size);
+
+ function fl_rgb_image_copy
+ (I : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_rgb_image_copy, "fl_rgb_image_copy");
+ pragma Inline (fl_rgb_image_copy);
+
+ function fl_rgb_image_copy2
+ (I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_rgb_image_copy2, "fl_rgb_image_copy2");
+ pragma Inline (fl_rgb_image_copy2);
+
+
+
+
+ procedure fl_rgb_image_color_average
+ (I : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ B : in Interfaces.C.C_float);
+ pragma Import (C, fl_rgb_image_color_average, "fl_rgb_image_color_average");
+ pragma Inline (fl_rgb_image_color_average);
+
+ procedure fl_rgb_image_desaturate
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_rgb_image_desaturate, "fl_rgb_image_desaturate");
+ pragma Inline (fl_rgb_image_desaturate);
+
+
+
+
+ procedure fl_rgb_image_uncache
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_rgb_image_uncache, "fl_rgb_image_uncache");
+ pragma Inline (fl_rgb_image_uncache);
+
+
+
+
+ procedure fl_rgb_image_draw2
+ (I : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_rgb_image_draw2, "fl_rgb_image_draw2");
+ pragma Inline (fl_rgb_image_draw2);
+
+ procedure fl_rgb_image_draw
+ (I : in Storage.Integer_Address;
+ X, Y, W, H, CX, CY : in Interfaces.C.int);
+ pragma Import (C, fl_rgb_image_draw, "fl_rgb_image_draw");
+ pragma Inline (fl_rgb_image_draw);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out RGB_Image) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_rgb_image (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (Data : in Color_Component_Array;
+ Width, Height : in Natural;
+ Depth : in Natural := 3;
+ Line_Data : in Natural := 0)
+ return RGB_Image is
+ begin
+ return This : RGB_Image do
+ This.Void_Ptr := new_fl_rgb_image
+ (Storage.To_Integer (Data (Data'First)'Address),
+ Interfaces.C.int (Width),
+ Interfaces.C.int (Height),
+ Interfaces.C.int (Depth),
+ Interfaces.C.int (Line_Data));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 => raise No_Image_Error;
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ function Create
+ (Data : in FLTK.Images.Pixmaps.Pixmap'Class;
+ Background : in Color := Background_Color)
+ return RGB_Image is
+ begin
+ return This : RGB_Image do
+ This.Void_Ptr := new_fl_rgb_image2
+ (Wrapper (Data).Void_Ptr,
+ Interfaces.C.unsigned (Background));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 => raise No_Image_Error;
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+ function Get_Max_Size
+ return Natural is
+ begin
+ return Natural (fl_rgb_image_get_max_size);
+ end Get_Max_Size;
+
+
+ procedure Set_Max_Size
+ (Value : in Natural) is
+ begin
+ fl_rgb_image_set_max_size (Interfaces.C.size_t (Value));
+ end Set_Max_Size;
+
+
+ function Copy
+ (This : in RGB_Image;
+ Width, Height : in Natural)
+ return RGB_Image'Class is
+ begin
+ return Copied : RGB_Image do
+ Copied.Void_Ptr := fl_rgb_image_copy
+ (This.Void_Ptr,
+ Interfaces.C.int (Width),
+ Interfaces.C.int (Height));
+ end return;
+ end Copy;
+
+
+ function Copy
+ (This : in RGB_Image)
+ return RGB_Image'Class is
+ begin
+ return Copied : RGB_Image do
+ Copied.Void_Ptr := fl_rgb_image_copy2 (This.Void_Ptr);
+ end return;
+ end Copy;
+
+
+
+
+ --------------
+ -- Colors --
+ --------------
+
+ procedure Color_Average
+ (This : in out RGB_Image;
+ Col : in Color;
+ Amount : in Blend) is
+ begin
+ fl_rgb_image_color_average
+ (This.Void_Ptr,
+ Interfaces.C.int (Col),
+ Interfaces.C.C_float (Amount));
+ end Color_Average;
+
+
+ procedure Desaturate
+ (This : in out RGB_Image) is
+ begin
+ fl_rgb_image_desaturate (This.Void_Ptr);
+ end Desaturate;
+
+
+
+
+ ----------------
+ -- Activity --
+ ----------------
+
+ procedure Uncache
+ (This : in out RGB_Image) is
+ begin
+ fl_rgb_image_uncache (This.Void_Ptr);
+ end Uncache;
+
+
+
+
+ ---------------
+ -- Drawing --
+ ---------------
+
+ procedure Draw
+ (This : in RGB_Image;
+ X, Y : in Integer) is
+ begin
+ fl_rgb_image_draw2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Draw;
+
+
+ procedure Draw
+ (This : in RGB_Image;
+ X, Y, W, H : in Integer;
+ CX, CY : in Integer := 0) is
+ begin
+ fl_rgb_image_draw
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (CX),
+ Interfaces.C.int (CY));
+ end Draw;
+
+
+end FLTK.Images.RGB;
+
diff --git a/body/fltk-images-shared.adb b/body/fltk-images-shared.adb
new file mode 100644
index 0000000..d475cc3
--- /dev/null
+++ b/body/fltk-images-shared.adb
@@ -0,0 +1,361 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Images.Shared is
+
+
+ function fl_shared_image_get
+ (F : in Interfaces.C.char_array;
+ W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_shared_image_get, "fl_shared_image_get");
+ pragma Inline (fl_shared_image_get);
+
+ function fl_shared_image_get2
+ (I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_shared_image_get2, "fl_shared_image_get2");
+ pragma Inline (fl_shared_image_get2);
+
+ function fl_shared_image_find
+ (N : in Interfaces.C.char_array;
+ W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_shared_image_find, "fl_shared_image_find");
+ pragma Inline (fl_shared_image_find);
+
+ procedure fl_shared_image_release
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_shared_image_release, "fl_shared_image_release");
+ pragma Inline (fl_shared_image_release);
+
+ function fl_shared_image_copy
+ (I : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_shared_image_copy, "fl_shared_image_copy");
+ pragma Inline (fl_shared_image_copy);
+
+ function fl_shared_image_copy2
+ (I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_shared_image_copy2, "fl_shared_image_copy2");
+ pragma Inline (fl_shared_image_copy2);
+
+
+
+
+ procedure fl_shared_image_color_average
+ (I : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ B : in Interfaces.C.C_float);
+ pragma Import (C, fl_shared_image_color_average, "fl_shared_image_color_average");
+ pragma Inline (fl_shared_image_color_average);
+
+ procedure fl_shared_image_desaturate
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_shared_image_desaturate, "fl_shared_image_desaturate");
+ pragma Inline (fl_shared_image_desaturate);
+
+
+
+
+ function fl_shared_image_num_images
+ return Interfaces.C.int;
+ pragma Import (C, fl_shared_image_num_images, "fl_shared_image_num_images");
+ pragma Inline (fl_shared_image_num_images);
+
+ function fl_shared_image_name
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_shared_image_name, "fl_shared_image_name");
+ pragma Inline (fl_shared_image_name);
+
+ function fl_shared_image_original
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_shared_image_original, "fl_shared_image_original");
+ pragma Inline (fl_shared_image_original);
+
+ function fl_shared_image_refcount
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_shared_image_refcount, "fl_shared_image_refcount");
+ pragma Inline (fl_shared_image_refcount);
+
+ procedure fl_shared_image_reload
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_shared_image_reload, "fl_shared_image_reload");
+ pragma Inline (fl_shared_image_reload);
+
+ procedure fl_shared_image_uncache
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_shared_image_uncache, "fl_shared_image_uncache");
+ pragma Inline (fl_shared_image_uncache);
+
+
+
+
+ procedure fl_shared_image_scaling_algorithm
+ (A : in Interfaces.C.int);
+ pragma Import (C, fl_shared_image_scaling_algorithm, "fl_shared_image_scaling_algorithm");
+ pragma Inline (fl_shared_image_scaling_algorithm);
+
+ procedure fl_shared_image_scale
+ (I : in Storage.Integer_Address;
+ W, H, P, E : in Interfaces.C.int);
+ pragma Import (C, fl_shared_image_scale, "fl_shared_image_scale");
+ pragma Inline (fl_shared_image_scale);
+
+ procedure fl_shared_image_draw
+ (I : in Storage.Integer_Address;
+ X, Y, W, H, CX, CY : in Interfaces.C.int);
+ pragma Import (C, fl_shared_image_draw, "fl_shared_image_draw");
+ pragma Inline (fl_shared_image_draw);
+
+ procedure fl_shared_image_draw2
+ (I : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_shared_image_draw2, "fl_shared_image_draw2");
+ pragma Inline (fl_shared_image_draw2);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out Shared_Image) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ fl_shared_image_release (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (Filename : in String;
+ W, H : in Integer)
+ return Shared_Image is
+ begin
+ return This : Shared_Image do
+ This.Void_Ptr := fl_shared_image_get
+ (Interfaces.C.To_C (Filename),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end return;
+ end Create;
+
+
+ function Create
+ (From : in FLTK.Images.RGB.RGB_Image'Class)
+ return Shared_Image is
+ begin
+ return This : Shared_Image do
+ This.Void_Ptr := fl_shared_image_get2 (Wrapper (From).Void_Ptr);
+ end return;
+ end Create;
+
+
+ function Find
+ (Name : in String;
+ W, H : in Integer := 0)
+ return Shared_Image is
+ begin
+ return This : Shared_Image do
+ This.Void_Ptr := fl_shared_image_find
+ (Interfaces.C.To_C (Name),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ if This.Void_Ptr = Null_Pointer then
+ raise No_Image_Error;
+ end if;
+ end return;
+ end Find;
+
+ end Forge;
+
+
+ function Copy
+ (This : in Shared_Image;
+ Width, Height : in Natural)
+ return Shared_Image'Class is
+ begin
+ return Copied : Shared_Image do
+ Copied.Void_Ptr := fl_shared_image_copy
+ (This.Void_Ptr,
+ Interfaces.C.int (Width),
+ Interfaces.C.int (Height));
+ end return;
+ end Copy;
+
+
+ function Copy
+ (This : in Shared_Image)
+ return Shared_Image'Class is
+ begin
+ return Copied : Shared_Image do
+ Copied.Void_Ptr := fl_shared_image_copy2 (This.Void_Ptr);
+ end return;
+ end Copy;
+
+
+
+
+ --------------
+ -- Colors --
+ --------------
+
+ procedure Color_Average
+ (This : in out Shared_Image;
+ Col : in Color;
+ Amount : in Blend) is
+ begin
+ fl_shared_image_color_average
+ (This.Void_Ptr,
+ Interfaces.C.int (Col),
+ Interfaces.C.C_float (Amount));
+ end Color_Average;
+
+
+ procedure Desaturate
+ (This : in out Shared_Image) is
+ begin
+ fl_shared_image_desaturate (This.Void_Ptr);
+ end Desaturate;
+
+
+
+
+ ----------------
+ -- Activity --
+ ----------------
+
+ function Number_Of_Images
+ return Natural is
+ begin
+ return Natural (fl_shared_image_num_images);
+ end Number_Of_Images;
+
+
+ function Name
+ (This : in Shared_Image)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_shared_image_name (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Name;
+
+
+ function Original
+ (This : in Shared_Image)
+ return Boolean is
+ begin
+ return fl_shared_image_original (This.Void_Ptr) /= 0;
+ end Original;
+
+
+ function Reference_Count
+ (This : in Shared_Image)
+ return Natural is
+ begin
+ return Natural (fl_shared_image_refcount (This.Void_Ptr));
+ end Reference_Count;
+
+
+ procedure Reload
+ (This : in out Shared_Image) is
+ begin
+ fl_shared_image_reload (This.Void_Ptr);
+ end Reload;
+
+
+ procedure Uncache
+ (This : in out Shared_Image) is
+ begin
+ fl_shared_image_uncache (This.Void_Ptr);
+ end Uncache;
+
+
+
+
+ ---------------
+ -- Drawing --
+ ---------------
+
+ procedure Set_Scaling_Algorithm
+ (To : in Scaling_Kind) is
+ begin
+ fl_shared_image_scaling_algorithm (Scaling_Kind'Pos (To));
+ end Set_Scaling_Algorithm;
+
+
+ procedure Scale
+ (This : in out Shared_Image;
+ W, H : in Integer;
+ Proportional : in Boolean := True;
+ Can_Expand : in Boolean := False) is
+ begin
+ fl_shared_image_scale
+ (This.Void_Ptr,
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Boolean'Pos (Proportional),
+ Boolean'Pos (Can_Expand));
+ end Scale;
+
+
+ procedure Draw
+ (This : in Shared_Image;
+ X, Y, W, H : in Integer;
+ CX, CY : in Integer := 0) is
+ begin
+ fl_shared_image_draw
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (CX),
+ Interfaces.C.int (CY));
+ end Draw;
+
+
+ procedure Draw
+ (This : in Shared_Image;
+ X, Y : in Integer) is
+ begin
+ fl_shared_image_draw2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Draw;
+
+
+end FLTK.Images.Shared;
+
diff --git a/body/fltk-images-tiled.adb b/body/fltk-images-tiled.adb
new file mode 100644
index 0000000..6bed730
--- /dev/null
+++ b/body/fltk-images-tiled.adb
@@ -0,0 +1,229 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Images.Tiled is
+
+
+ function new_fl_tiled_image
+ (T : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_tiled_image, "new_fl_tiled_image");
+ pragma Inline (new_fl_tiled_image);
+
+ procedure free_fl_tiled_image
+ (T : in Storage.Integer_Address);
+ pragma Import (C, free_fl_tiled_image, "free_fl_tiled_image");
+ pragma Inline (free_fl_tiled_image);
+
+ function fl_tiled_image_copy
+ (T : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_tiled_image_copy, "fl_tiled_image_copy");
+ pragma Inline (fl_tiled_image_copy);
+
+ function fl_tiled_image_copy2
+ (T : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_tiled_image_copy2, "fl_tiled_image_copy2");
+ pragma Inline (fl_tiled_image_copy2);
+
+
+
+
+ function fl_tiled_image_get_image
+ (T : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_tiled_image_get_image, "fl_tiled_image_get_image");
+ pragma Inline (fl_tiled_image_get_image);
+
+
+
+
+ procedure fl_tiled_image_color_average
+ (T : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ B : in Interfaces.C.C_float);
+ pragma Import (C, fl_tiled_image_color_average, "fl_tiled_image_color_average");
+ pragma Inline (fl_tiled_image_color_average);
+
+ procedure fl_tiled_image_desaturate
+ (T : in Storage.Integer_Address);
+ pragma Import (C, fl_tiled_image_desaturate, "fl_tiled_image_desaturate");
+ pragma Inline (fl_tiled_image_desaturate);
+
+
+
+
+ procedure fl_tiled_image_draw
+ (T : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_tiled_image_draw, "fl_tiled_image_draw");
+ pragma Inline (fl_tiled_image_draw);
+
+ procedure fl_tiled_image_draw2
+ (T : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ CX, CY : in Interfaces.C.int);
+ pragma Import (C, fl_tiled_image_draw2, "fl_tiled_image_draw2");
+ pragma Inline (fl_tiled_image_draw2);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out Tiled_Image) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_tiled_image (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (From : in out Image'Class;
+ W, H : in Integer := 0)
+ return Tiled_Image is
+ begin
+ return This : Tiled_Image do
+ This.Void_Ptr := new_fl_tiled_image
+ (From.Void_Ptr,
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr);
+ This.Dummy.Needs_Dealloc := False;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+ function Copy
+ (This : in Tiled_Image;
+ Width, Height : in Natural)
+ return Tiled_Image'Class is
+ begin
+ return Copied : Tiled_Image do
+ Copied.Void_Ptr := fl_tiled_image_copy
+ (This.Void_Ptr,
+ Interfaces.C.int (Width),
+ Interfaces.C.int (Height));
+ Copied.Dummy.Void_Ptr := fl_tiled_image_get_image (Copied.Void_Ptr);
+ Copied.Dummy.Needs_Dealloc := False;
+ end return;
+ end Copy;
+
+
+ function Copy
+ (This : in Tiled_Image)
+ return Tiled_Image'Class is
+ begin
+ return Copied : Tiled_Image do
+ Copied.Void_Ptr := fl_tiled_image_copy2 (This.Void_Ptr);
+ Copied.Dummy.Void_Ptr := fl_tiled_image_get_image (Copied.Void_Ptr);
+ Copied.Dummy.Needs_Dealloc := False;
+ end return;
+ end Copy;
+
+
+
+
+ ---------------------
+ -- Miscellaneous --
+ ---------------------
+
+ procedure Inactive
+ (This : in out Tiled_Image) is
+ begin
+ This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr);
+ This.Dummy.Needs_Dealloc := False;
+ Image (This).Inactive;
+ end Inactive;
+
+
+ function Tile
+ (This : in out Tiled_Image)
+ return Image_Reference is
+ begin
+ return (Data => This.Dummy'Unchecked_Access);
+ end Tile;
+
+
+
+
+ --------------
+ -- Colors --
+ --------------
+
+ procedure Color_Average
+ (This : in out Tiled_Image;
+ Hue : in Color;
+ Amount : in Blend) is
+ begin
+ This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr);
+ This.Dummy.Needs_Dealloc := False;
+ fl_tiled_image_color_average
+ (This.Void_Ptr,
+ Interfaces.C.int (Hue),
+ Interfaces.C.C_float (Amount));
+ end Color_Average;
+
+
+ procedure Desaturate
+ (This : in out Tiled_Image) is
+ begin
+ This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr);
+ This.Dummy.Needs_Dealloc := False;
+ fl_tiled_image_desaturate (This.Void_Ptr);
+ end Desaturate;
+
+
+
+
+ procedure Draw
+ (This : in Tiled_Image;
+ X, Y : in Integer) is
+ begin
+ fl_tiled_image_draw
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Draw;
+
+
+ procedure Draw
+ (This : in Tiled_Image;
+ X, Y, W, H : in Integer;
+ CX, CY : in Integer) is
+ begin
+ fl_tiled_image_draw2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (CX),
+ Interfaces.C.int (CY));
+ end Draw;
+
+
+end FLTK.Images.Tiled;
+
diff --git a/body/fltk-images.adb b/body/fltk-images.adb
new file mode 100644
index 0000000..19a1f86
--- /dev/null
+++ b/body/fltk-images.adb
@@ -0,0 +1,489 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Images is
+
+
+ function new_fl_image
+ (W, H, D : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_image, "new_fl_image");
+ pragma Inline (new_fl_image);
+
+ procedure free_fl_image
+ (I : in Storage.Integer_Address);
+ pragma Import (C, free_fl_image, "free_fl_image");
+ pragma Inline (free_fl_image);
+
+
+
+
+ function fl_image_get_rgb_scaling
+ return Interfaces.C.int;
+ pragma Import (C, fl_image_get_rgb_scaling, "fl_image_get_rgb_scaling");
+ pragma Inline (fl_image_get_rgb_scaling);
+
+ procedure fl_image_set_rgb_scaling
+ (T : in Interfaces.C.int);
+ pragma Import (C, fl_image_set_rgb_scaling, "fl_image_set_rgb_scaling");
+ pragma Inline (fl_image_set_rgb_scaling);
+
+ function fl_image_copy
+ (I : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_image_copy, "fl_image_copy");
+ pragma Inline (fl_image_copy);
+
+ function fl_image_copy2
+ (I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_image_copy2, "fl_image_copy2");
+ pragma Inline (fl_image_copy2);
+
+
+
+
+ procedure fl_image_color_average
+ (I : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ B : in Interfaces.C.C_float);
+ pragma Import (C, fl_image_color_average, "fl_image_color_average");
+ pragma Inline (fl_image_color_average);
+
+ procedure fl_image_desaturate
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_image_desaturate, "fl_image_desaturate");
+ pragma Inline (fl_image_desaturate);
+
+
+
+
+ procedure fl_image_inactive
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_image_inactive, "fl_image_inactive");
+ pragma Inline (fl_image_inactive);
+
+ procedure fl_image_uncache
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_image_uncache, "fl_image_uncache");
+ pragma Inline (fl_image_uncache);
+
+
+
+
+ function fl_image_w
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_image_w, "fl_image_w");
+ pragma Inline (fl_image_w);
+
+ function fl_image_h
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_image_h, "fl_image_h");
+ pragma Inline (fl_image_h);
+
+ function fl_image_d
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_image_d, "fl_image_d");
+ pragma Inline (fl_image_d);
+
+ function fl_image_ld
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_image_ld, "fl_image_ld");
+ pragma Inline (fl_image_ld);
+
+ function fl_image_count
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_image_count, "fl_image_count");
+ pragma Inline (fl_image_count);
+
+
+
+
+ function fl_image_data
+ (I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_image_data, "fl_image_data");
+ pragma Inline (fl_image_data);
+
+ function fl_image_get_pixel
+ (C : in Interfaces.C.Strings.chars_ptr;
+ O : in Interfaces.C.int)
+ return Interfaces.C.unsigned_char;
+ pragma Import (C, fl_image_get_pixel, "fl_image_get_pixel");
+ pragma Inline (fl_image_get_pixel);
+
+ procedure fl_image_set_pixel
+ (C : in Interfaces.C.Strings.chars_ptr;
+ O : in Interfaces.C.int;
+ V : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_image_set_pixel, "fl_image_set_pixel");
+ pragma Inline (fl_image_set_pixel);
+
+
+
+
+ procedure fl_image_draw
+ (I : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_image_draw, "fl_image_draw");
+ pragma Inline (fl_image_draw);
+
+ procedure fl_image_draw2
+ (I : in Storage.Integer_Address;
+ X, Y, W, H, CX, CY : in Interfaces.C.int);
+ pragma Import (C, fl_image_draw2, "fl_image_draw2");
+ pragma Inline (fl_image_draw2);
+
+ procedure fl_image_draw_empty
+ (I : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_image_draw_empty, "fl_image_draw_empty");
+ pragma Inline (fl_image_draw_empty);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out Image) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_image (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ 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));
+ case fl_image_fail (This.Void_Ptr) is
+ when 1 => raise No_Image_Error;
+ when 2 => raise File_Access_Error;
+ when 3 => raise Format_Error;
+ when others => null;
+ end case;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+ function Get_Copy_Algorithm
+ return Scaling_Kind is
+ begin
+ return Scaling_Kind'Val (fl_image_get_rgb_scaling);
+ end Get_Copy_Algorithm;
+
+
+ procedure Set_Copy_Algorithm
+ (To : in Scaling_Kind) is
+ begin
+ fl_image_set_rgb_scaling (Scaling_Kind'Pos (To));
+ end Set_Copy_Algorithm;
+
+
+ function Copy
+ (This : in Image;
+ Width, Height : in Natural)
+ return Image'Class is
+ begin
+ return Copied : Image do
+ Copied.Void_Ptr := fl_image_copy
+ (This.Void_Ptr,
+ Interfaces.C.int (Width),
+ Interfaces.C.int (Height));
+ end return;
+ end Copy;
+
+
+ function Copy
+ (This : in Image)
+ return Image'Class is
+ begin
+ return Copied : Image do
+ Copied.Void_Ptr := fl_image_copy2 (This.Void_Ptr);
+ end return;
+ end Copy;
+
+
+
+
+ --------------
+ -- Colors --
+ --------------
+
+ procedure Color_Average
+ (This : in out Image;
+ Col : in Color;
+ Amount : in Blend) is
+ begin
+ fl_image_color_average
+ (This.Void_Ptr,
+ Interfaces.C.int (Col),
+ Interfaces.C.C_float (Amount));
+ end Color_Average;
+
+
+ procedure Desaturate
+ (This : in out Image) is
+ begin
+ fl_image_desaturate (This.Void_Ptr);
+ end Desaturate;
+
+
+
+
+ ----------------
+ -- Activity --
+ ----------------
+
+ procedure Inactive
+ (This : in out Image) is
+ begin
+ fl_image_inactive (This.Void_Ptr);
+ end Inactive;
+
+
+ function Is_Empty
+ (This : in Image)
+ return Boolean is
+ begin
+ return fl_image_fail (This.Void_Ptr) /= 0;
+ end Is_Empty;
+
+
+ procedure Uncache
+ (This : in out Image) is
+ begin
+ fl_image_uncache (This.Void_Ptr);
+ end Uncache;
+
+
+
+
+ ------------------
+ -- Dimensions --
+ ------------------
+
+ 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;
+
+
+ function Get_Line_Data
+ (This : in Image)
+ return Natural is
+ begin
+ return Natural (fl_image_ld (This.Void_Ptr));
+ end Get_Line_Data;
+
+
+ function Get_Data_Count
+ (This : in Image)
+ return Natural is
+ begin
+ return Natural (fl_image_count (This.Void_Ptr));
+ end Get_Data_Count;
+
+
+ function Get_Data_Size
+ (This : in Image)
+ return Natural
+ is
+ My_Depth : Natural := This.Get_D;
+ My_Line_Data : Natural := This.Get_Line_Data;
+ begin
+ if My_Line_Data > 0 then
+ return My_Line_Data * This.Get_H;
+ elsif My_Depth = 0 then
+ return Integer (Float'Ceiling (Float (This.Get_W) / 8.0)) * This.Get_H;
+ else
+ return This.Get_W * My_Depth * This.Get_H;
+ end if;
+ end Get_Data_Size;
+
+
+
+
+ ------------------
+ -- Pixel Data --
+ ------------------
+
+ function Get_Datum
+ (This : in Image;
+ Data : in Positive;
+ Position : in Positive)
+ return Color_Component
+ is
+ Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr;
+ for Pointers'Address use Storage.To_Address (fl_image_data (This.Void_Ptr));
+ pragma Import (Ada, Pointers);
+ begin
+ return Color_Component
+ (fl_image_get_pixel (Pointers (Data), Interfaces.C.int (Position) - 1));
+ end Get_Datum;
+
+
+ procedure Set_Datum
+ (This : in out Image;
+ Data : in Positive;
+ Position : in Positive;
+ Value : in Color_Component)
+ is
+ Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr;
+ for Pointers'Address use Storage.To_Address (fl_image_data (This.Void_Ptr));
+ pragma Import (Ada, Pointers);
+ begin
+ fl_image_set_pixel
+ (Pointers (Data),
+ Interfaces.C.int (Position) - 1,
+ Interfaces.C.unsigned_char (Value));
+ end Set_Datum;
+
+
+ function Get_Data
+ (This : in Image;
+ Data : in Positive;
+ Position : in Positive;
+ Count : in Natural)
+ return Color_Component_Array
+ is
+ Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr;
+ for Pointers'Address use Storage.To_Address (fl_image_data (This.Void_Ptr));
+ pragma Import (Ada, Pointers);
+ Result : Color_Component_Array := (1 .. Count => 0);
+ begin
+ for Index in Result'Range loop
+ Result (Index) := Color_Component (fl_image_get_pixel
+ (Pointers (Data),
+ Interfaces.C.int (Index - 1 + Position - 1)));
+ end loop;
+ return Result;
+ end Get_Data;
+
+
+ function All_Data
+ (This : in Image;
+ Data : in Positive)
+ return Color_Component_Array is
+ begin
+ return This.Get_Data (Data, 1, This.Get_Data_Size);
+ end All_Data;
+
+
+ procedure Update_Data
+ (This : in out Image;
+ Data : in Positive;
+ Position : in Positive;
+ Values : in Color_Component_Array)
+ is
+ Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr;
+ for Pointers'Address use Storage.To_Address (fl_image_data (This.Void_Ptr));
+ pragma Import (Ada, Pointers);
+ begin
+ for Counter in Integer range 0 .. Values'Length - 1 loop
+ fl_image_set_pixel
+ (Pointers (Data),
+ Interfaces.C.int (Position - 1 + Counter),
+ Interfaces.C.unsigned_char (Values (Values'First + Counter)));
+ end loop;
+ end Update_Data;
+
+
+
+
+ ---------------
+ -- Drawing --
+ ---------------
+
+ procedure Draw
+ (This : in Image;
+ X, Y : in Integer) is
+ begin
+ fl_image_draw
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Draw;
+
+
+ procedure Draw
+ (This : in Image;
+ X, Y, W, H : in Integer;
+ CX, CY : in Integer := 0) is
+ begin
+ fl_image_draw2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (CX),
+ Interfaces.C.int (CY));
+ end Draw;
+
+
+ procedure Draw_Empty
+ (This : in Image;
+ X, Y : in Integer) is
+ begin
+ fl_image_draw_empty
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Draw_Empty;
+
+
+end FLTK.Images;
+
diff --git a/body/fltk-labels.adb b/body/fltk-labels.adb
new file mode 100644
index 0000000..006db6b
--- /dev/null
+++ b/body/fltk-labels.adb
@@ -0,0 +1,355 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings;
+
+
+package body FLTK.Labels is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_label
+ (V : in Interfaces.C.Strings.chars_ptr;
+ F : in Interfaces.C.int;
+ S : in Interfaces.C.int;
+ H : in Interfaces.C.unsigned;
+ K : in Interfaces.C.int;
+ P : in Interfaces.C.unsigned)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_label, "new_fl_label");
+ pragma Inline (new_fl_label);
+
+ procedure free_fl_label
+ (L : in Storage.Integer_Address);
+ pragma Import (C, free_fl_label, "free_fl_label");
+ pragma Inline (free_fl_label);
+
+
+
+
+ procedure fl_label_set_value
+ (L : in Storage.Integer_Address;
+ V : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_label_set_value, "fl_label_set_value");
+ pragma Inline (fl_label_set_value);
+
+ function fl_label_get_font
+ (L : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_label_get_font, "fl_label_get_font");
+ pragma Inline (fl_label_get_font);
+
+ procedure fl_label_set_font
+ (L : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_label_set_font, "fl_label_set_font");
+ pragma Inline (fl_label_set_font);
+
+ function fl_label_get_size
+ (L : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_label_get_size, "fl_label_get_size");
+ pragma Inline (fl_label_get_size);
+
+ procedure fl_label_set_size
+ (L : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_label_set_size, "fl_label_set_size");
+ pragma Inline (fl_label_set_size);
+
+ function fl_label_get_color
+ (L : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_label_get_color, "fl_label_get_color");
+ pragma Inline (fl_label_get_color);
+
+ procedure fl_label_set_color
+ (L : in Storage.Integer_Address;
+ H : in Interfaces.C.unsigned);
+ pragma Import (C, fl_label_set_color, "fl_label_set_color");
+ pragma Inline (fl_label_set_color);
+
+ function fl_label_get_type
+ (L : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_label_get_type, "fl_label_get_type");
+ pragma Inline (fl_label_get_type);
+
+ procedure fl_label_set_type
+ (L : in Storage.Integer_Address;
+ K : in Interfaces.C.int);
+ pragma Import (C, fl_label_set_type, "fl_label_set_type");
+ pragma Inline (fl_label_set_type);
+
+ function fl_label_get_align
+ (L : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_label_get_align, "fl_label_get_align");
+ pragma Inline (fl_label_get_align);
+
+ procedure fl_label_set_align
+ (L : in Storage.Integer_Address;
+ P : in Interfaces.C.unsigned);
+ pragma Import (C, fl_label_set_align, "fl_label_set_align");
+ pragma Inline (fl_label_set_align);
+
+ procedure fl_label_set_image
+ (L, I : in Storage.Integer_Address);
+ pragma Import (C, fl_label_set_image, "fl_label_set_image");
+ pragma Inline (fl_label_set_image);
+
+ procedure fl_label_set_deimage
+ (L, I : in Storage.Integer_Address);
+ pragma Import (C, fl_label_set_deimage, "fl_label_set_deimage");
+ pragma Inline (fl_label_set_deimage);
+
+
+
+
+ procedure fl_label_draw
+ (L : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ P : in Interfaces.C.unsigned);
+ pragma Import (C, fl_label_draw, "fl_label_draw");
+ pragma Inline (fl_label_draw);
+
+ procedure fl_label_measure
+ (L : in Storage.Integer_Address;
+ W, H : out Interfaces.C.int);
+ pragma Import (C, fl_label_measure, "fl_label_measure");
+ pragma Inline (fl_label_measure);
+
+
+
+
+ -----------------------------------
+ -- Controlled Type Subprograms --
+ -----------------------------------
+
+ procedure Finalize
+ (This : in out Label) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_label (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ Interfaces.C.Strings.Free (This.My_Text);
+ end if;
+ end Finalize;
+
+
+
+
+ -----------------
+ -- Label API --
+ -----------------
+
+ package body Forge is
+
+ function Create
+ (Value : in String;
+ Font : in Font_Kind := Helvetica;
+ Size : in Font_Size := Normal_Size;
+ Hue : in Color := Foreground_Color;
+ Kind : in Label_Kind := Normal_Label;
+ Place : in Alignment := Align_Center;
+ Active : access FLTK.Images.Image'Class := null;
+ Inactive : access FLTK.Images.Image'Class := null)
+ return Label is
+ begin
+ return This : Label do
+ This.My_Text := Interfaces.C.Strings.New_String (Value);
+ This.Void_Ptr := new_fl_label
+ (This.My_Text, -- Interfaces.C.Strings.chars_ptr
+ Font_Kind'Pos (Font), -- Interfaces.C.int
+ Interfaces.C.int (Size),
+ Interfaces.C.unsigned (Hue),
+ Label_Kind'Pos (Kind), -- Interfaces.C.int
+ Interfaces.C.unsigned (Place));
+ This.Set_Active (Active);
+ This.Set_Inactive (Inactive);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ function Get_Value
+ (This : in Label)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (This.My_Text);
+ end Get_Value;
+
+
+ procedure Set_Value
+ (This : in out Label;
+ Text : in String) is
+ begin
+ Interfaces.C.Strings.Free (This.My_Text);
+ This.My_Text := Interfaces.C.Strings.New_String (Text);
+ fl_label_set_value (This.Void_Ptr, This.My_Text);
+ end Set_Value;
+
+
+ function Get_Font
+ (This : in Label)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_label_get_font (This.Void_Ptr));
+ end Get_Font;
+
+
+ procedure Set_Font
+ (This : in out Label;
+ Font : in Font_Kind) is
+ begin
+ fl_label_set_font (This.Void_Ptr, Font_Kind'Pos (Font));
+ end Set_Font;
+
+
+ function Get_Size
+ (This : in Label)
+ return Font_Size is
+ begin
+ return Font_Size (fl_label_get_size (This.Void_Ptr));
+ end Get_Size;
+
+
+ procedure Set_Size
+ (This : in out Label;
+ Size : in Font_Size) is
+ begin
+ fl_label_set_size (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Size;
+
+
+ function Get_Color
+ (This : in Label)
+ return Color is
+ begin
+ return Color (fl_label_get_color (This.Void_Ptr));
+ end Get_Color;
+
+
+ procedure Set_Color
+ (This : in out Label;
+ Hue : in Color) is
+ begin
+ fl_label_set_color (This.Void_Ptr, Interfaces.C.unsigned (Hue));
+ end Set_Color;
+
+
+ function Get_Kind
+ (This : in Label)
+ return Label_Kind is
+ begin
+ return Label_Kind'Val (fl_label_get_type (This.Void_Ptr));
+ end Get_Kind;
+
+
+ procedure Set_Kind
+ (This : in out Label;
+ Kind : in Label_Kind) is
+ begin
+ fl_label_set_type (This.Void_Ptr, Label_Kind'Pos (Kind));
+ end Set_Kind;
+
+
+ function Get_Alignment
+ (This : in Label)
+ return Alignment is
+ begin
+ return Alignment (fl_label_get_align (This.Void_Ptr));
+ end Get_Alignment;
+
+
+ procedure Set_Alignment
+ (This : in out Label;
+ Place : in Alignment) is
+ begin
+ fl_label_set_align (This.Void_Ptr, Interfaces.C.unsigned (Place));
+ end Set_Alignment;
+
+
+ function Get_Active
+ (This : in Label)
+ return access FLTK.Images.Image'Class is
+ begin
+ return This.My_Active;
+ end Get_Active;
+
+
+ procedure Set_Active
+ (This : in out Label;
+ Pic : access FLTK.Images.Image'Class) is
+ begin
+ if Pic /= null then
+ fl_label_set_image (This.Void_Ptr, Wrapper (Pic.all).Void_Ptr);
+ else
+ fl_label_set_image (This.Void_Ptr, Null_Pointer);
+ end if;
+ This.My_Active := Pic;
+ end Set_Active;
+
+
+ function Get_Inactive
+ (This : in Label)
+ return access FLTK.Images.Image'Class is
+ begin
+ return This.My_Inactive;
+ end Get_Inactive;
+
+
+ procedure Set_Inactive
+ (This : in out Label;
+ Pic : access FLTK.Images.Image'Class) is
+ begin
+ if Pic /= null then
+ fl_label_set_deimage (This.Void_Ptr, Wrapper (Pic.all).Void_Ptr);
+ else
+ fl_label_set_deimage (This.Void_Ptr, Null_Pointer);
+ end if;
+ This.My_Inactive := Pic;
+ end Set_Inactive;
+
+
+
+
+ procedure Draw
+ (This : in out Label;
+ X, Y, W, H : in Integer;
+ Place : in Alignment) is
+ begin
+ fl_label_draw
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.unsigned (Place));
+ end Draw;
+
+ procedure Measure
+ (This : in Label;
+ W, H : out Integer) is
+ begin
+ fl_label_measure
+ (This.Void_Ptr,
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Measure;
+
+
+end FLTK.Labels;
+
+
diff --git a/body/fltk-menu_items.adb b/body/fltk-menu_items.adb
new file mode 100644
index 0000000..d68eb60
--- /dev/null
+++ b/body/fltk-menu_items.adb
@@ -0,0 +1,604 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widget_Callback_Conversions,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Menu_Items is
+
+
+ package Callback_Convert renames FLTK.Widget_Callback_Conversions;
+
+
+
+
+ function new_fl_menu_item
+ (T : in Interfaces.C.char_array;
+ C : in Storage.Integer_Address;
+ S, F : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_menu_item, "new_fl_menu_item");
+ pragma Inline (new_fl_menu_item);
+
+ procedure free_fl_menu_item
+ (MI : in Storage.Integer_Address);
+ pragma Import (C, free_fl_menu_item, "free_fl_menu_item");
+ pragma Inline (free_fl_menu_item);
+
+
+
+
+ function fl_menu_item_get_user_data
+ (MI : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_item_get_user_data, "fl_menu_item_get_user_data");
+ pragma Inline (fl_menu_item_get_user_data);
+
+ procedure fl_menu_item_set_callback
+ (MI, C : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_item_set_callback, "fl_menu_item_set_callback");
+ pragma Inline (fl_menu_item_set_callback);
+
+ procedure fl_menu_item_do_callback
+ (MI, W : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_item_do_callback, "fl_menu_item_do_callback");
+ pragma Inline (fl_menu_item_do_callback);
+
+
+
+
+ function fl_menu_item_checkbox
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_checkbox, "fl_menu_item_checkbox");
+ pragma Inline (fl_menu_item_checkbox);
+
+ function fl_menu_item_radio
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_radio, "fl_menu_item_radio");
+ pragma Inline (fl_menu_item_radio);
+
+ function fl_menu_item_submenu
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_submenu, "fl_menu_item_submenu");
+ pragma Inline (fl_menu_item_submenu);
+
+ function fl_menu_item_value
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_value, "fl_menu_item_value");
+ pragma Inline (fl_menu_item_value);
+
+ procedure fl_menu_item_set
+ (MI : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_item_set, "fl_menu_item_set");
+ pragma Inline (fl_menu_item_set);
+
+ procedure fl_menu_item_clear
+ (MI : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_item_clear, "fl_menu_item_clear");
+ pragma Inline (fl_menu_item_clear);
+
+ procedure fl_menu_item_setonly
+ (MI : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_item_setonly, "fl_menu_item_setonly");
+ pragma Inline (fl_menu_item_setonly);
+
+
+
+
+ function fl_menu_item_get_label
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_menu_item_get_label, "fl_menu_item_get_label");
+ pragma Inline (fl_menu_item_get_label);
+
+ procedure fl_menu_item_set_label
+ (MI : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_menu_item_set_label, "fl_menu_item_set_label");
+ pragma Inline (fl_menu_item_set_label);
+
+ procedure fl_menu_item_set_label2
+ (MI : in Storage.Integer_Address;
+ K : in Interfaces.C.int;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_menu_item_set_label2, "fl_menu_item_set_label2");
+ pragma Inline (fl_menu_item_set_label2);
+
+ function fl_menu_item_get_labelcolor
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_menu_item_get_labelcolor, "fl_menu_item_get_labelcolor");
+ pragma Inline (fl_menu_item_get_labelcolor);
+
+ procedure fl_menu_item_set_labelcolor
+ (MI : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_menu_item_set_labelcolor, "fl_menu_item_set_labelcolor");
+ pragma Inline (fl_menu_item_set_labelcolor);
+
+ function fl_menu_item_get_labelfont
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_get_labelfont, "fl_menu_item_get_labelfont");
+ pragma Inline (fl_menu_item_get_labelfont);
+
+ procedure fl_menu_item_set_labelfont
+ (MI : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_menu_item_set_labelfont, "fl_menu_item_set_labelfont");
+ pragma Inline (fl_menu_item_set_labelfont);
+
+ function fl_menu_item_get_labelsize
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_get_labelsize, "fl_menu_item_get_labelsize");
+ pragma Inline (fl_menu_item_get_labelsize);
+
+ procedure fl_menu_item_set_labelsize
+ (MI : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_menu_item_set_labelsize, "fl_menu_item_set_labelsize");
+ pragma Inline (fl_menu_item_set_labelsize);
+
+ function fl_menu_item_get_labeltype
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_get_labeltype, "fl_menu_item_get_labeltype");
+ pragma Inline (fl_menu_item_get_labeltype);
+
+ procedure fl_menu_item_set_labeltype
+ (MI : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_menu_item_set_labeltype, "fl_menu_item_set_labeltype");
+ pragma Inline (fl_menu_item_set_labeltype);
+
+
+
+
+ function fl_menu_item_get_shortcut
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_get_shortcut, "fl_menu_item_get_shortcut");
+ pragma Inline (fl_menu_item_get_shortcut);
+
+ procedure fl_menu_item_set_shortcut
+ (MI : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_menu_item_set_shortcut, "fl_menu_item_set_shortcut");
+ pragma Inline (fl_menu_item_set_shortcut);
+
+ function fl_menu_item_get_flags
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_get_flags, "fl_menu_item_get_flags");
+ pragma Inline (fl_menu_item_get_flags);
+
+ procedure fl_menu_item_set_flags
+ (MI : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_menu_item_set_flags, "fl_menu_item_set_flags");
+ pragma Inline (fl_menu_item_set_flags);
+
+
+
+
+ procedure fl_menu_item_image
+ (MI, I : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_item_image, "fl_menu_item_image");
+ pragma Inline (fl_menu_item_image);
+
+
+
+
+ procedure fl_menu_item_activate
+ (MI : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_item_activate, "fl_menu_item_activate");
+ pragma Inline (fl_menu_item_activate);
+
+ procedure fl_menu_item_deactivate
+ (MI : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_item_deactivate, "fl_menu_item_deactivate");
+ pragma Inline (fl_menu_item_deactivate);
+
+ procedure fl_menu_item_show
+ (MI : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_item_show, "fl_menu_item_show");
+ pragma Inline (fl_menu_item_show);
+
+ procedure fl_menu_item_hide
+ (MI : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_item_hide, "fl_menu_item_hide");
+ pragma Inline (fl_menu_item_hide);
+
+ function fl_menu_item_active
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_active, "fl_menu_item_active");
+ pragma Inline (fl_menu_item_active);
+
+ function fl_menu_item_visible
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_visible, "fl_menu_item_visible");
+ pragma Inline (fl_menu_item_visible);
+
+ function fl_menu_item_activevisible
+ (MI : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_activevisible, "fl_menu_item_activevisible");
+ pragma Inline (fl_menu_item_activevisible);
+
+
+
+
+ procedure Finalize
+ (This : in out Menu_Item) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_menu_item (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ package body Forge is
+
+ function Create
+ (Text : in String;
+ Action : in FLTK.Widgets.Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Menu_Item is
+ begin
+ return This : Menu_Item do
+ This.Void_Ptr := new_fl_menu_item
+ (Interfaces.C.To_C (Text),
+ Callback_Convert.To_Address (Action),
+ To_C (Shortcut),
+ Interfaces.C.int (Flags));
+ end return;
+ end Create;
+
+ pragma Inline (Create);
+
+ end Forge;
+
+
+
+
+ function Get_Callback
+ (This : in Menu_Item)
+ return FLTK.Widgets.Widget_Callback is
+ begin
+ return Callback_Convert.To_Access (fl_menu_item_get_user_data (This.Void_Ptr));
+ end Get_Callback;
+
+
+ procedure Set_Callback
+ (This : in out Menu_Item;
+ Func : in FLTK.Widgets.Widget_Callback) is
+ begin
+ -- Coordinating callback vs userdata is done in C++
+ fl_menu_item_set_callback
+ (This.Void_Ptr,
+ Callback_Convert.To_Address (Func));
+ end Set_Callback;
+
+
+ procedure Do_Callback
+ (This : in out Menu_Item;
+ Widget : in out FLTK.Widgets.Widget'Class) is
+ begin
+ fl_menu_item_do_callback (This.Void_Ptr, Wrapper (Widget).Void_Ptr);
+ end Do_Callback;
+
+
+
+
+ function Has_Checkbox
+ (This : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_checkbox (This.Void_Ptr) /= 0;
+ end Has_Checkbox;
+
+
+ function Is_Radio
+ (This : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_radio (This.Void_Ptr) /= 0;
+ end Is_Radio;
+
+
+ function Is_Submenu
+ (This : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_submenu (This.Void_Ptr) /= 0;
+ end Is_Submenu;
+
+
+ function Get_State
+ (This : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_value (This.Void_Ptr) /= 0;
+ end Get_State;
+
+
+ procedure Set_State
+ (This : in out Menu_Item;
+ To : in Boolean) is
+ begin
+ if To then
+ fl_menu_item_set (This.Void_Ptr);
+ else
+ fl_menu_item_clear (This.Void_Ptr);
+ end if;
+ end Set_State;
+
+
+ procedure Set
+ (This : in out Menu_Item) is
+ begin
+ fl_menu_item_set (This.Void_Ptr);
+ end Set;
+
+
+ procedure Clear
+ (This : in out Menu_Item) is
+ begin
+ fl_menu_item_clear (This.Void_Ptr);
+ end Clear;
+
+
+ procedure Set_Only
+ (This : in out Menu_Item) is
+ begin
+ fl_menu_item_setonly (This.Void_Ptr);
+ end Set_Only;
+
+
+
+
+ function Get_Label
+ (This : in Menu_Item)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_menu_item_get_label (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Get_Label;
+
+
+ procedure Set_Label
+ (This : in out Menu_Item;
+ Text : in String) is
+ begin
+ fl_menu_item_set_label (This.Void_Ptr, Interfaces.C.To_C (Text));
+ end Set_Label;
+
+
+ procedure Set_Label
+ (This : in out Menu_Item;
+ Kind : in Label_Kind;
+ Text : in String) is
+ begin
+ fl_menu_item_set_label2 (This.Void_Ptr, Label_Kind'Pos (Kind), Interfaces.C.To_C (Text));
+ end Set_Label;
+
+
+ function Get_Label_Color
+ (This : in Menu_Item)
+ return Color is
+ begin
+ return Color (fl_menu_item_get_labelcolor (This.Void_Ptr));
+ end Get_Label_Color;
+
+
+ procedure Set_Label_Color
+ (This : in out Menu_Item;
+ To : in Color) is
+ begin
+ fl_menu_item_set_labelcolor (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Label_Color;
+
+
+ function Get_Label_Font
+ (This : in Menu_Item)
+ return Font_Kind
+ is
+ Result : Interfaces.C.int := fl_menu_item_get_labelfont (This.Void_Ptr);
+ begin
+ return Font_Kind'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Menu_Item::labelfont returned unexpected Font value of " &
+ Interfaces.C.int'Image (Result);
+ end Get_Label_Font;
+
+
+ procedure Set_Label_Font
+ (This : in out Menu_Item;
+ To : in Font_Kind) is
+ begin
+ fl_menu_item_set_labelfont (This.Void_Ptr, Font_Kind'Pos (To));
+ end Set_Label_Font;
+
+
+ function Get_Label_Size
+ (This : in Menu_Item)
+ return Font_Size
+ is
+ Result : Interfaces.C.int := fl_menu_item_get_labelsize (This.Void_Ptr);
+ begin
+ return Font_Size (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Menu_Item::labelsize returned unexpected Size value of " &
+ Interfaces.C.int'Image (Result);
+ end Get_Label_Size;
+
+
+ procedure Set_Label_Size
+ (This : in out Menu_Item;
+ To : in Font_Size) is
+ begin
+ fl_menu_item_set_labelsize (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Label_Size;
+
+
+ function Get_Label_Kind
+ (This : in Menu_Item)
+ return Label_Kind
+ is
+ Result : Interfaces.C.int := fl_menu_item_get_labeltype (This.Void_Ptr);
+ begin
+ return Label_Kind'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Menu_Item::labeltype returned unexpected Kind value of " &
+ Interfaces.C.int'Image (Result);
+ end Get_Label_Kind;
+
+
+ procedure Set_Label_Kind
+ (This : in out Menu_Item;
+ To : in Label_Kind) is
+ begin
+ fl_menu_item_set_labeltype (This.Void_Ptr, Label_Kind'Pos (To));
+ end Set_Label_Kind;
+
+
+
+
+ function Get_Shortcut
+ (This : in Menu_Item)
+ return Key_Combo is
+ begin
+ return To_Ada (fl_menu_item_get_shortcut (This.Void_Ptr));
+ end Get_Shortcut;
+
+
+ procedure Set_Shortcut
+ (This : in out Menu_Item;
+ To : in Key_Combo) is
+ begin
+ fl_menu_item_set_shortcut (This.Void_Ptr, Interfaces.C.int (To_C (To)));
+ end Set_Shortcut;
+
+
+ function Get_Flags
+ (This : in Menu_Item)
+ return Menu_Flag is
+ begin
+ return Menu_Flag (fl_menu_item_get_flags (This.Void_Ptr));
+ end Get_Flags;
+
+
+ procedure Set_Flags
+ (This : in out Menu_Item;
+ To : in Menu_Flag) is
+ begin
+ fl_menu_item_set_flags (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Flags;
+
+
+
+
+ function Get_Image
+ (This : in Menu_Item)
+ return access FLTK.Images.Image'Class is
+ begin
+ return This.Current_Image;
+ end Get_Image;
+
+
+ procedure Set_Image
+ (This : in out Menu_Item;
+ Pict : in out FLTK.Images.Image'Class) is
+ begin
+ fl_menu_item_image (This.Void_Ptr, Wrapper (Pict).Void_Ptr);
+ This.Current_Image := Pict'Unchecked_Access;
+ end Set_Image;
+
+
+
+
+ procedure Activate
+ (This : in out Menu_Item) is
+ begin
+ fl_menu_item_activate (This.Void_Ptr);
+ end Activate;
+
+
+ procedure Deactivate
+ (This : in out Menu_Item) is
+ begin
+ fl_menu_item_deactivate (This.Void_Ptr);
+ end Deactivate;
+
+
+ procedure Show
+ (This : in out Menu_Item) is
+ begin
+ fl_menu_item_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Hide
+ (This : in out Menu_Item) is
+ begin
+ fl_menu_item_hide (This.Void_Ptr);
+ end Hide;
+
+
+ function Is_Active
+ (This : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_active (This.Void_Ptr) /= 0;
+ end Is_Active;
+
+
+ function Is_Visible
+ (This : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_visible (This.Void_Ptr) /= 0;
+ end Is_Visible;
+
+
+ function Is_Active_And_Visible
+ (This : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_activevisible (This.Void_Ptr) /= 0;
+ end Is_Active_And_Visible;
+
+
+end FLTK.Menu_Items;
+
+
diff --git a/body/fltk-screen.adb b/body/fltk-screen.adb
new file mode 100644
index 0000000..ad25cbe
--- /dev/null
+++ b/body/fltk-screen.adb
@@ -0,0 +1,282 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Screen is
+
+
+ function fl_screen_x
+ return Interfaces.C.int;
+ pragma Import (C, fl_screen_x, "fl_screen_x");
+ pragma Inline (fl_screen_x);
+
+ function fl_screen_y
+ return Interfaces.C.int;
+ pragma Import (C, fl_screen_y, "fl_screen_y");
+ pragma Inline (fl_screen_y);
+
+ function fl_screen_w
+ return Interfaces.C.int;
+ pragma Import (C, fl_screen_w, "fl_screen_w");
+ pragma Inline (fl_screen_w);
+
+ function fl_screen_h
+ return Interfaces.C.int;
+ pragma Import (C, fl_screen_h, "fl_screen_h");
+ pragma Inline (fl_screen_h);
+
+
+
+
+ function fl_screen_count
+ return Interfaces.C.int;
+ pragma Import (C, fl_screen_count, "fl_screen_count");
+ pragma Inline (fl_screen_count);
+
+ procedure fl_screen_dpi
+ (H, V : out Interfaces.C.C_float;
+ N : in Interfaces.C.int);
+ pragma Import (C, fl_screen_dpi, "fl_screen_dpi");
+ pragma Inline (fl_screen_dpi);
+
+
+
+
+ function fl_screen_num
+ (X, Y : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_screen_num, "fl_screen_num");
+ pragma Inline (fl_screen_num);
+
+ function fl_screen_num2
+ (X, Y, W, H : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_screen_num2, "fl_screen_num2");
+ pragma Inline (fl_screen_num2);
+
+
+
+
+ procedure fl_screen_work_area
+ (X, Y, W, H : out Interfaces.C.int;
+ PX, PY : in Interfaces.C.int);
+ pragma Import (C, fl_screen_work_area, "fl_screen_work_area");
+ pragma Inline (fl_screen_work_area);
+
+ procedure fl_screen_work_area2
+ (X, Y, W, H : out Interfaces.C.int;
+ N : in Interfaces.C.int);
+ pragma Import (C, fl_screen_work_area2, "fl_screen_work_area2");
+ pragma Inline (fl_screen_work_area2);
+
+ procedure fl_screen_work_area3
+ (X, Y, W, H : out Interfaces.C.int);
+ pragma Import (C, fl_screen_work_area3, "fl_screen_work_area3");
+ pragma Inline (fl_screen_work_area3);
+
+
+
+
+ procedure fl_screen_xywh
+ (X, Y, W, H : out Interfaces.C.int;
+ PX, PY : in Interfaces.C.int);
+ pragma Import (C, fl_screen_xywh, "fl_screen_xywh");
+ pragma Inline (fl_screen_xywh);
+
+ procedure fl_screen_xywh2
+ (X, Y, W, H : out Interfaces.C.int;
+ N : in Interfaces.C.int);
+ pragma Import (C, fl_screen_xywh2, "fl_screen_xywh2");
+ pragma Inline (fl_screen_xywh2);
+
+ procedure fl_screen_xywh3
+ (X, Y, W, H : out Interfaces.C.int);
+ pragma Import (C, fl_screen_xywh3, "fl_screen_xywh3");
+ pragma Inline (fl_screen_xywh3);
+
+ procedure fl_screen_xywh4
+ (X, Y, W, H : out Interfaces.C.int;
+ PX, PY, PW, PH : in Interfaces.C.int);
+ pragma Import (C, fl_screen_xywh4, "fl_screen_xywh4");
+ pragma Inline (fl_screen_xywh4);
+
+
+
+
+ function Get_X return Integer is
+ begin
+ return Integer (fl_screen_x);
+ end Get_X;
+
+
+ function Get_Y return Integer is
+ begin
+ return Integer (fl_screen_y);
+ end Get_Y;
+
+
+ function Get_W return Integer is
+ begin
+ return Integer (fl_screen_w);
+ end Get_W;
+
+
+ function Get_H return Integer is
+ begin
+ return Integer (fl_screen_h);
+ end Get_H;
+
+
+
+
+ function Count return Integer is
+ begin
+ return Integer (fl_screen_count);
+ end Count;
+
+
+ -- Screen numbers in the range 1 .. Get_Count
+ procedure DPI
+ (Horizontal, Vertical : out Float;
+ Screen_Number : in Integer := 1) is
+ begin
+ fl_screen_dpi
+ (Interfaces.C.C_float (Horizontal),
+ Interfaces.C.C_float (Vertical),
+ Interfaces.C.int (Screen_Number) - 1);
+ end DPI;
+
+
+
+
+ function Containing
+ (X, Y : in Integer)
+ return Integer is
+ begin
+ return Integer (fl_screen_num
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y)));
+ end Containing;
+
+
+ function Containing
+ (X, Y, W, H : in Integer)
+ return Integer is
+ begin
+ return Integer (fl_screen_num2
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H)));
+ end Containing;
+
+
+
+
+ procedure Work_Area
+ (X, Y, W, H : out Integer;
+ Pos_X, Pos_Y : in Integer) is
+ begin
+ fl_screen_work_area
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Pos_X),
+ Interfaces.C.int (Pos_Y));
+ end Work_Area;
+
+
+ procedure Work_Area
+ (X, Y, W, H : out Integer;
+ Screen_Num : in Integer) is
+ begin
+ fl_screen_work_area2
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Screen_Num));
+ end Work_Area;
+
+
+ procedure Work_Area
+ (X, Y, W, H : out Integer) is
+ begin
+ fl_screen_work_area3
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Work_Area;
+
+
+
+
+ procedure Bounding_Rect
+ (X, Y, W, H : out Integer;
+ Pos_X, Pos_Y : in Integer) is
+ begin
+ fl_screen_xywh
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Pos_X),
+ Interfaces.C.int (Pos_Y));
+ end Bounding_Rect;
+
+
+ procedure Bounding_Rect
+ (X, Y, W, H : out Integer;
+ Screen_Num : in Integer) is
+ begin
+ fl_screen_xywh2
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Screen_Num));
+ end Bounding_Rect;
+
+
+ procedure Bounding_Rect
+ (X, Y, W, H : out Integer) is
+ begin
+ fl_screen_xywh3
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Bounding_Rect;
+
+
+ procedure Bounding_Rect
+ (X, Y, W, H : out Integer;
+ PX, PY, PW, PH : in Integer) is
+ begin
+ fl_screen_xywh4
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (PX),
+ Interfaces.C.int (PY),
+ Interfaces.C.int (PW),
+ Interfaces.C.int (PH));
+ end Bounding_Rect;
+
+
+end FLTK.Screen;
+
diff --git a/body/fltk-show_argv.adb b/body/fltk-show_argv.adb
new file mode 100644
index 0000000..52e22e2
--- /dev/null
+++ b/body/fltk-show_argv.adb
@@ -0,0 +1,50 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Command_Line,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Show_Argv is
+
+
+ package ACom renames Ada.Command_Line;
+ package IntC renames Interfaces.C;
+ package ICS renames Interfaces.C.Strings;
+
+
+ function Create_Argv
+ return ICS.chars_ptr_array
+ is
+ Result : ICS.chars_ptr_array (0 .. IntC.size_t (ACom.Argument_Count));
+ begin
+ Result (0) := ICS.New_String (ACom.Command_Name);
+ for Index in Integer range 1 .. ACom.Argument_Count loop
+ Result (IntC.size_t (Index)) := ICS.New_String (ACom.Argument (Index));
+ end loop;
+ return Result;
+ end Create_Argv;
+
+
+ procedure Dispatch
+ (Func : in Show_With_Args_Func;
+ CObj : in Storage.Integer_Address)
+ is
+ Argv : ICS.chars_ptr_array := Create_Argv;
+ begin
+ Func (CObj, IntC.int (ACom.Argument_Count + 1),
+ Storage.To_Integer (Argv (Argv'First)'Address));
+ for Ptr of Argv loop
+ ICS.Free (Ptr);
+ end loop;
+ end Dispatch;
+
+
+end FLTK.Show_Argv;
+
+
diff --git a/body/fltk-show_argv.ads b/body/fltk-show_argv.ads
new file mode 100644
index 0000000..231b875
--- /dev/null
+++ b/body/fltk-show_argv.ads
@@ -0,0 +1,35 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+private package FLTK.Show_Argv is
+
+
+ -- Used for implementing show(argc,argv)
+
+ type Show_With_Args_Func is access procedure
+ (CObj : in Storage.Integer_Address;
+ Argc : in Interfaces.C.int;
+ Argv : in Storage.Integer_Address);
+
+ procedure Dispatch
+ (Func : in Show_With_Args_Func;
+ CObj : in Storage.Integer_Address);
+
+
+private
+
+
+ pragma Convention (C, Show_With_Args_Func);
+
+
+end FLTK.Show_Argv;
+
+
diff --git a/body/fltk-static.adb b/body/fltk-static.adb
new file mode 100644
index 0000000..56b30c0
--- /dev/null
+++ b/body/fltk-static.adb
@@ -0,0 +1,1055 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Ada.Containers.Vectors,
+ Interfaces.C.Strings,
+ System.Address_To_Access_Conversions,
+ FLTK.Static_Callback_Conversions;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Static is
+
+
+ package Chk renames Ada.Assertions;
+ package Conv renames FLTK.Static_Callback_Conversions;
+
+
+
+
+ procedure fl_static_add_awake_handler
+ (H, F : in Storage.Integer_Address);
+ pragma Import (C, fl_static_add_awake_handler, "fl_static_add_awake_handler");
+ pragma Inline (fl_static_add_awake_handler);
+
+ procedure fl_static_get_awake_handler
+ (H, F : out Storage.Integer_Address);
+ pragma Import (C, fl_static_get_awake_handler, "fl_static_get_awake_handler");
+ pragma Inline (fl_static_get_awake_handler);
+
+
+
+
+ procedure fl_static_add_check
+ (H, F : in Storage.Integer_Address);
+ pragma Import (C, fl_static_add_check, "fl_static_add_check");
+ pragma Inline (fl_static_add_check);
+
+ function fl_static_has_check
+ (H, F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_has_check, "fl_static_has_check");
+ pragma Inline (fl_static_has_check);
+
+ procedure fl_static_remove_check
+ (H, F : in Storage.Integer_Address);
+ pragma Import (C, fl_static_remove_check, "fl_static_remove_check");
+ pragma Inline (fl_static_remove_check);
+
+
+
+
+ procedure fl_static_add_timeout
+ (S : in Interfaces.C.double;
+ H, F : in Storage.Integer_Address);
+ pragma Import (C, fl_static_add_timeout, "fl_static_add_timeout");
+ pragma Inline (fl_static_add_timeout);
+
+ function fl_static_has_timeout
+ (H, F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_has_timeout, "fl_static_has_timeout");
+ pragma Inline (fl_static_has_timeout);
+
+ procedure fl_static_remove_timeout
+ (H, F : in Storage.Integer_Address);
+ pragma Import (C, fl_static_remove_timeout, "fl_static_remove_timeout");
+ pragma Inline (fl_static_remove_timeout);
+
+ procedure fl_static_repeat_timeout
+ (S : in Interfaces.C.double;
+ H, F : in Storage.Integer_Address);
+ pragma Import (C, fl_static_repeat_timeout, "fl_static_repeat_timeout");
+ pragma Inline (fl_static_repeat_timeout);
+
+
+
+
+ procedure fl_static_add_clipboard_notify
+ (H, F : in Storage.Integer_Address);
+ pragma Import (C, fl_static_add_clipboard_notify, "fl_static_add_clipboard_notify");
+ pragma Inline (fl_static_add_clipboard_notify);
+
+
+
+
+ procedure fl_static_add_fd
+ (D : in Interfaces.C.int;
+ H, F : in Storage.Integer_Address);
+ pragma Import (C, fl_static_add_fd, "fl_static_add_fd");
+ pragma Inline (fl_static_add_fd);
+
+ procedure fl_static_add_fd2
+ (D, M : in Interfaces.C.int;
+ H, F : in Storage.Integer_Address);
+ pragma Import (C, fl_static_add_fd2, "fl_static_add_fd2");
+ pragma Inline (fl_static_add_fd2);
+
+ procedure fl_static_remove_fd
+ (D : in Interfaces.C.int);
+ pragma Import (C, fl_static_remove_fd, "fl_static_remove_fd");
+ pragma Inline (fl_static_remove_fd);
+
+ procedure fl_static_remove_fd2
+ (D, M : in Interfaces.C.int);
+ pragma Import (C, fl_static_remove_fd2, "fl_static_remove_fd2");
+ pragma Inline (fl_static_remove_fd2);
+
+
+
+
+ procedure fl_static_add_idle
+ (H, F : in Storage.Integer_Address);
+ pragma Import (C, fl_static_add_idle, "fl_static_add_idle");
+ pragma Inline (fl_static_add_idle);
+
+ function fl_static_has_idle
+ (H, F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_has_idle, "fl_static_has_idle");
+ pragma Inline (fl_static_has_idle);
+
+ procedure fl_static_remove_idle
+ (H, F : in Storage.Integer_Address);
+ pragma Import (C, fl_static_remove_idle, "fl_static_remove_idle");
+ pragma Inline (fl_static_remove_idle);
+
+
+
+
+ procedure fl_static_get_color
+ (C : in Interfaces.C.unsigned;
+ R, G, B : out Interfaces.C.unsigned_char);
+ pragma Import (C, fl_static_get_color, "fl_static_get_color");
+ pragma Inline (fl_static_get_color);
+
+ procedure fl_static_set_color
+ (C : in Interfaces.C.unsigned;
+ R, G, B : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_static_set_color, "fl_static_set_color");
+ pragma Inline (fl_static_set_color);
+
+ procedure fl_static_free_color
+ (C : in Interfaces.C.unsigned;
+ B : in Interfaces.C.int);
+ pragma Import (C, fl_static_free_color, "fl_static_free_color");
+ pragma Inline (fl_static_free_color);
+
+ procedure fl_static_foreground
+ (R, G, B : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_static_foreground, "fl_static_foreground");
+ pragma Inline (fl_static_foreground);
+
+ procedure fl_static_background
+ (R, G, B : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_static_background, "fl_static_background");
+ pragma Inline (fl_static_background);
+
+ procedure fl_static_background2
+ (R, G, B : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_static_background2, "fl_static_background2");
+ pragma Inline (fl_static_background2);
+
+
+
+
+ function fl_static_get_font
+ (K : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_static_get_font, "fl_static_get_font");
+ pragma Inline (fl_static_get_font);
+
+ function fl_static_get_font_name
+ (K : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_static_get_font_name, "fl_static_get_font_name");
+ pragma Inline (fl_static_get_font_name);
+
+ procedure fl_static_set_font
+ (T, F : in Interfaces.C.int);
+ pragma Import (C, fl_static_set_font, "fl_static_set_font");
+ pragma Inline (fl_static_set_font);
+
+ function fl_static_get_font_sizes
+ (F : in Interfaces.C.int;
+ A : out Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_get_font_sizes, "fl_static_get_font_sizes");
+ pragma Inline (fl_static_get_font_sizes);
+
+ function fl_static_font_size_array_get
+ (A : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_font_size_array_get, "fl_static_font_size_array_get");
+ pragma Inline (fl_static_font_size_array_get);
+
+ function fl_static_set_fonts
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_set_fonts, "fl_static_set_fonts");
+ pragma Inline (fl_static_set_fonts);
+
+
+
+
+ function fl_static_box_dh
+ (B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_box_dh, "fl_static_box_dh");
+ pragma Inline (fl_static_box_dh);
+
+ function fl_static_box_dw
+ (B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_box_dw, "fl_static_box_dw");
+ pragma Inline (fl_static_box_dw);
+
+ function fl_static_box_dx
+ (B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_box_dx, "fl_static_box_dx");
+ pragma Inline (fl_static_box_dx);
+
+ function fl_static_box_dy
+ (B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_box_dy, "fl_static_box_dy");
+ pragma Inline (fl_static_box_dy);
+
+ procedure fl_static_set_boxtype
+ (T, F : in Interfaces.C.int);
+ pragma Import (C, fl_static_set_boxtype, "fl_static_set_boxtype");
+ pragma Inline (fl_static_set_boxtype);
+
+ function fl_static_draw_box_active
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_draw_box_active, "fl_static_draw_box_active");
+ pragma Inline (fl_static_draw_box_active);
+
+
+
+
+ procedure fl_static_copy
+ (T : in Interfaces.C.char_array;
+ L, K : in Interfaces.C.int);
+ pragma Import (C, fl_static_copy, "fl_static_copy");
+ pragma Inline (fl_static_copy);
+
+ procedure fl_static_paste
+ (R : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_static_paste, "fl_static_paste");
+ pragma Inline (fl_static_paste);
+
+ procedure fl_static_selection
+ (O : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_static_selection, "fl_static_selection");
+ pragma Inline (fl_static_selection);
+
+
+
+
+ function fl_static_get_dnd_text_ops
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_get_dnd_text_ops, "fl_static_get_dnd_text_ops");
+ pragma Inline (fl_static_get_dnd_text_ops);
+
+ procedure fl_static_set_dnd_text_ops
+ (T : in Interfaces.C.int);
+ pragma Import (C, fl_static_set_dnd_text_ops, "fl_static_set_dnd_text_ops");
+ pragma Inline (fl_static_set_dnd_text_ops);
+
+
+
+
+ function fl_static_get_visible_focus
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_get_visible_focus, "fl_static_get_visible_focus");
+ pragma Inline (fl_static_get_visible_focus);
+
+ procedure fl_static_set_visible_focus
+ (T : in Interfaces.C.int);
+ pragma Import (C, fl_static_set_visible_focus, "fl_static_set_visible_focus");
+ pragma Inline (fl_static_set_visible_focus);
+
+
+
+
+ procedure fl_static_default_atclose
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_static_default_atclose, "fl_static_default_atclose");
+ pragma Inline (fl_static_default_atclose);
+
+ function fl_static_get_first_window
+ return Storage.Integer_Address;
+ pragma Import (C, fl_static_get_first_window, "fl_static_get_first_window");
+ pragma Inline (fl_static_get_first_window);
+
+ procedure fl_static_set_first_window
+ (T : in Storage.Integer_Address);
+ pragma Import (C, fl_static_set_first_window, "fl_static_set_first_window");
+ pragma Inline (fl_static_set_first_window);
+
+ function fl_static_next_window
+ (W : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_static_next_window, "fl_static_next_window");
+ pragma Inline (fl_static_next_window);
+
+ function fl_static_modal
+ return Storage.Integer_Address;
+ pragma Import (C, fl_static_modal, "fl_static_modal");
+ pragma Inline (fl_static_modal);
+
+
+
+
+ function fl_static_readqueue
+ return Storage.Integer_Address;
+ pragma Import (C, fl_static_readqueue, "fl_static_readqueue");
+ pragma Inline (fl_static_readqueue);
+
+
+
+
+ function fl_static_get_scheme
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_static_get_scheme, "fl_static_get_scheme");
+ pragma Inline (fl_static_get_scheme);
+
+ procedure fl_static_set_scheme
+ (S : in Interfaces.C.char_array);
+ pragma Import (C, fl_static_set_scheme, "fl_static_set_scheme");
+ pragma Inline (fl_static_set_scheme);
+
+ function fl_static_is_scheme
+ (S : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_is_scheme, "fl_static_is_scheme");
+ pragma Inline (fl_static_is_scheme);
+
+
+
+
+ function fl_static_get_option
+ (O : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_get_option, "fl_static_get_option");
+ pragma Inline (fl_static_get_option);
+
+ procedure fl_static_set_option
+ (O, T : in Interfaces.C.int);
+ pragma Import (C, fl_static_set_option, "fl_static_set_option");
+ pragma Inline (fl_static_set_option);
+
+
+
+
+ function fl_static_get_scrollbar_size
+ return Interfaces.C.int;
+ pragma Import (C, fl_static_get_scrollbar_size, "fl_static_get_scrollbar_size");
+ pragma Inline (fl_static_get_scrollbar_size);
+
+ procedure fl_static_set_scrollbar_size
+ (S : in Interfaces.C.int);
+ pragma Import (C, fl_static_set_scrollbar_size, "fl_static_set_scrollbar_size");
+ pragma Inline (fl_static_set_scrollbar_size);
+
+
+
+
+ package Widget_Convert is new System.Address_To_Access_Conversions
+ (FLTK.Widgets.Widget'Class);
+ package Window_Convert is new System.Address_To_Access_Conversions
+ (FLTK.Widgets.Groups.Windows.Window'Class);
+
+ function fl_widget_get_user_data
+ (W : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data");
+
+
+
+
+ procedure Awake_Hook
+ (U : in Storage.Integer_Address);
+ pragma Convention (C, Awake_Hook);
+
+ procedure Awake_Hook
+ (U : in Storage.Integer_Address) is
+ begin
+ Conv.To_Awake_Access (U).all;
+ end Awake_Hook;
+
+
+ procedure Add_Awake_Handler
+ (Func : in Awake_Handler) is
+ begin
+ fl_static_add_awake_handler
+ (Storage.To_Integer (Awake_Hook'Address), Conv.To_Address (Func));
+ end Add_Awake_Handler;
+
+
+ function Get_Awake_Handler
+ return Awake_Handler
+ is
+ Hook, Func : Storage.Integer_Address;
+ begin
+ fl_static_get_awake_handler (Hook, Func);
+ return Conv.To_Awake_Access (Func);
+ end Get_Awake_Handler;
+
+
+
+
+ procedure Timeout_Hook
+ (U : in Storage.Integer_Address);
+ pragma Convention (C, Timeout_Hook);
+
+ procedure Timeout_Hook
+ (U : in Storage.Integer_Address) is
+ begin
+ Conv.To_Timeout_Access (U).all;
+ end Timeout_Hook;
+
+
+ procedure Add_Check
+ (Func : in Timeout_Handler) is
+ begin
+ fl_static_add_check
+ (Storage.To_Integer (Timeout_Hook'Address), Conv.To_Address (Func));
+ end Add_Check;
+
+
+ function Has_Check
+ (Func : in Timeout_Handler)
+ return Boolean is
+ begin
+ return fl_static_has_check
+ (Storage.To_Integer (Timeout_Hook'Address),
+ Conv.To_Address (Func)) /= 0;
+ end Has_Check;
+
+
+ procedure Remove_Check
+ (Func : in Timeout_Handler) is
+ begin
+ fl_static_remove_check
+ (Storage.To_Integer (Timeout_Hook'Address),
+ Conv.To_Address (Func));
+ end Remove_Check;
+
+
+
+
+ procedure Add_Timeout
+ (Seconds : in Long_Float;
+ Func : in Timeout_Handler) is
+ begin
+ fl_static_add_timeout
+ (Interfaces.C.double (Seconds),
+ Storage.To_Integer (Timeout_Hook'Address),
+ Conv.To_Address (Func));
+ end Add_Timeout;
+
+
+ function Has_Timeout
+ (Func : in Timeout_Handler)
+ return Boolean is
+ begin
+ return fl_static_has_timeout
+ (Storage.To_Integer (Timeout_Hook'Address),
+ Conv.To_Address (Func)) /= 0;
+ end Has_Timeout;
+
+
+ procedure Remove_Timeout
+ (Func : in Timeout_Handler) is
+ begin
+ fl_static_remove_timeout
+ (Storage.To_Integer (Timeout_Hook'Address),
+ Conv.To_Address (Func));
+ end Remove_Timeout;
+
+
+ procedure Repeat_Timeout
+ (Seconds : in Long_Float;
+ Func : in Timeout_Handler) is
+ begin
+ fl_static_repeat_timeout
+ (Interfaces.C.double (Seconds),
+ Storage.To_Integer (Timeout_Hook'Address),
+ Conv.To_Address (Func));
+ end Repeat_Timeout;
+
+
+
+
+ -- This is handled on the Ada side because otherwise there would be
+ -- no way to specify which callback to remove in FLTK once one was
+ -- added. The hook is passed during package init.
+ package Clipboard_Notify_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Clipboard_Notify_Handler);
+
+ Current_Clip_Notes : Clipboard_Notify_Vectors.Vector;
+
+ procedure Clipboard_Notify_Hook
+ (S : in Interfaces.C.int;
+ U : in Storage.Integer_Address);
+ pragma Convention (C, Clipboard_Notify_Hook);
+
+ procedure Clipboard_Notify_Hook
+ (S : in Interfaces.C.int;
+ U : in Storage.Integer_Address) is
+ begin
+ for Call of Current_Clip_Notes loop
+ Call.all (Buffer_Kind'Val (S));
+ end loop;
+ end Clipboard_Notify_Hook;
+
+
+ procedure Add_Clipboard_Notify
+ (Func : in Clipboard_Notify_Handler) is
+ begin
+ Current_Clip_Notes.Append (Func);
+ end Add_Clipboard_Notify;
+
+
+ procedure Remove_Clipboard_Notify
+ (Func : in Clipboard_Notify_Handler) is
+ begin
+ for Index in Current_Clip_Notes.First_Index .. Current_Clip_Notes.Last_Index loop
+ if Current_Clip_Notes (Index) = Func then
+ Current_Clip_Notes.Delete (Index);
+ return;
+ end if;
+ end loop;
+ end Remove_Clipboard_Notify;
+
+
+
+
+ procedure FD_Hook
+ (FD : in Interfaces.C.int;
+ U : in Storage.Integer_Address);
+ pragma Convention (C, FD_Hook);
+
+ procedure FD_Hook
+ (FD : in Interfaces.C.int;
+ U : in Storage.Integer_Address) is
+ begin
+ Conv.To_File_Access (U).all (File_Descriptor (FD));
+ end FD_Hook;
+
+
+ procedure Add_File_Descriptor
+ (FD : in File_Descriptor;
+ Func : in File_Handler) is
+ begin
+ fl_static_add_fd
+ (Interfaces.C.int (FD),
+ Storage.To_Integer (FD_Hook'Address),
+ Conv.To_Address (Func));
+ end Add_File_Descriptor;
+
+
+ procedure Add_File_Descriptor
+ (FD : in File_Descriptor;
+ Mode : in File_Mode;
+ Func : in File_Handler) is
+ begin
+ fl_static_add_fd2
+ (Interfaces.C.int (FD),
+ File_Mode_Codes (Mode),
+ Storage.To_Integer (FD_Hook'Address),
+ Conv.To_Address (Func));
+ end Add_File_Descriptor;
+
+
+ procedure Remove_File_Descriptor
+ (FD : in File_Descriptor) is
+ begin
+ fl_static_remove_fd (Interfaces.C.int (FD));
+ end Remove_File_Descriptor;
+
+
+ procedure Remove_File_Descriptor
+ (FD : in File_Descriptor;
+ Mode : in File_Mode) is
+ begin
+ fl_static_remove_fd2 (Interfaces.C.int (FD), File_Mode_Codes (Mode));
+ end Remove_File_Descriptor;
+
+
+
+
+ procedure Idle_Hook
+ (U : in Storage.Integer_Address);
+ pragma Convention (C, Idle_Hook);
+
+ procedure Idle_Hook
+ (U : in Storage.Integer_Address) is
+ begin
+ Conv.To_Idle_Access (U).all;
+ end Idle_Hook;
+
+
+ procedure Add_Idle
+ (Func : in Idle_Handler) is
+ begin
+ fl_static_add_idle
+ (Storage.To_Integer (Idle_Hook'Address),
+ Conv.To_Address (Func));
+ end Add_Idle;
+
+
+ function Has_Idle
+ (Func : in Idle_Handler)
+ return Boolean is
+ begin
+ return fl_static_has_idle
+ (Storage.To_Integer (Idle_Hook'Address),
+ Conv.To_Address (Func)) /= 0;
+ end Has_Idle;
+
+
+ procedure Remove_Idle
+ (Func : in Idle_Handler) is
+ begin
+ fl_static_remove_idle
+ (Storage.To_Integer (Idle_Hook'Address),
+ Conv.To_Address (Func));
+ end Remove_Idle;
+
+
+
+
+ procedure Get_Color
+ (From : in Color;
+ R, G, B : out Color_Component) is
+ begin
+ fl_static_get_color
+ (Interfaces.C.unsigned (From),
+ Interfaces.C.unsigned_char (R),
+ Interfaces.C.unsigned_char (G),
+ Interfaces.C.unsigned_char (B));
+ end Get_Color;
+
+
+ procedure Set_Color
+ (To : in Color;
+ R, G, B : in Color_Component) is
+ begin
+ fl_static_set_color
+ (Interfaces.C.unsigned (To),
+ Interfaces.C.unsigned_char (R),
+ Interfaces.C.unsigned_char (G),
+ Interfaces.C.unsigned_char (B));
+ end Set_Color;
+
+
+ procedure Free_Color
+ (Value : in Color;
+ Overlay : in Boolean := False) is
+ begin
+ fl_static_free_color
+ (Interfaces.C.unsigned (Value),
+ Boolean'Pos (Overlay));
+ end Free_Color;
+
+
+ procedure Set_Foreground
+ (R, G, B : in Color_Component) is
+ begin
+ fl_static_foreground
+ (Interfaces.C.unsigned_char (R),
+ Interfaces.C.unsigned_char (G),
+ Interfaces.C.unsigned_char (B));
+ end Set_Foreground;
+
+
+ procedure Set_Background
+ (R, G, B : in Color_Component) is
+ begin
+ fl_static_background
+ (Interfaces.C.unsigned_char (R),
+ Interfaces.C.unsigned_char (G),
+ Interfaces.C.unsigned_char (B));
+ end Set_Background;
+
+
+ procedure Set_Alt_Background
+ (R, G, B : in Color_Component) is
+ begin
+ fl_static_background2
+ (Interfaces.C.unsigned_char (R),
+ Interfaces.C.unsigned_char (G),
+ Interfaces.C.unsigned_char (B));
+ end Set_Alt_Background;
+
+
+
+
+ function Font_Image
+ (Kind : in Font_Kind)
+ return String is
+ begin
+ -- should never get a null string in return since it's from an enum
+ return Interfaces.C.Strings.Value (fl_static_get_font (Font_Kind'Pos (Kind)));
+ end Font_Image;
+
+
+ function Font_Family_Image
+ (Kind : in Font_Kind)
+ return String is
+ begin
+ -- should never get a null string in return since it's from an enum
+ return Interfaces.C.Strings.Value (fl_static_get_font_name (Font_Kind'Pos (Kind)));
+ end Font_Family_Image;
+
+
+ procedure Set_Font_Kind
+ (To, From : in Font_Kind) is
+ begin
+ fl_static_set_font (Font_Kind'Pos (To), Font_Kind'Pos (From));
+ end Set_Font_Kind;
+
+
+ function Font_Sizes
+ (Kind : in Font_Kind)
+ return Font_Size_Array
+ is
+ Ptr : Storage.Integer_Address;
+ Arr : Font_Size_Array
+ (1 .. Integer (fl_static_get_font_sizes (Font_Kind'Pos (Kind), Ptr)));
+ begin
+ -- This array copying avoids any worry that the static buffer will be overwritten.
+ for I in 1 .. Arr'Length loop
+ Arr (I) := Font_Size (fl_static_font_size_array_get (Ptr, Interfaces.C.int (I)));
+ end loop;
+ return Arr;
+ end Font_Sizes;
+
+
+ procedure Setup_Fonts
+ (How_Many_Set_Up : out Natural) is
+ begin
+ How_Many_Set_Up := Natural (fl_static_set_fonts);
+ end Setup_Fonts;
+
+
+
+
+ function Get_Box_Height_Offset
+ (Kind : in Box_Kind)
+ return Integer is
+ begin
+ return Integer (fl_static_box_dh (Box_Kind'Pos (Kind)));
+ end Get_Box_Height_Offset;
+
+
+ function Get_Box_Width_Offset
+ (Kind : in Box_Kind)
+ return Integer is
+ begin
+ return Integer (fl_static_box_dw (Box_Kind'Pos (Kind)));
+ end Get_Box_Width_Offset;
+
+
+ function Get_Box_X_Offset
+ (Kind : in Box_Kind)
+ return Integer is
+ begin
+ return Integer (fl_static_box_dx (Box_Kind'Pos (Kind)));
+ end Get_Box_X_Offset;
+
+
+ function Get_Box_Y_Offset
+ (Kind : in Box_Kind)
+ return Integer is
+ begin
+ return Integer (fl_static_box_dy (Box_Kind'Pos (Kind)));
+ end Get_Box_Y_Offset;
+
+
+ procedure Set_Box_Kind
+ (To, From : in Box_Kind) is
+ begin
+ fl_static_set_boxtype (Box_Kind'Pos (To), Box_Kind'Pos (From));
+ end Set_Box_Kind;
+
+
+ function Draw_Box_Active
+ return Boolean is
+ begin
+ return fl_static_draw_box_active /= 0;
+ end Draw_Box_Active;
+
+
+ -- function Get_Box_Draw_Function
+ -- (Kind : in Box_Kind)
+ -- return Box_Draw_Function is
+ -- begin
+ -- return null;
+ -- end Get_Box_Draw_Function;
+
+
+ -- procedure Set_Box_Draw_Function
+ -- (Kind : in Box_Kind;
+ -- Func : in Box_Draw_Function;
+ -- Offset_X, Offset_Y : in Integer := 0;
+ -- Offset_W, Offset_H : in Integer := 0) is
+ -- begin
+ -- null;
+ -- end Set_Box_Draw_Function;
+
+
+
+
+ procedure Copy
+ (Text : in String;
+ Dest : in Buffer_Kind) is
+ begin
+ fl_static_copy
+ (Interfaces.C.To_C (Text),
+ Text'Length,
+ Buffer_Kind'Pos (Dest));
+ end Copy;
+
+
+ procedure Paste
+ (Receiver : in FLTK.Widgets.Widget'Class;
+ Source : in Buffer_Kind) is
+ begin
+ fl_static_paste
+ (Wrapper (Receiver).Void_Ptr,
+ Buffer_Kind'Pos (Source));
+ end Paste;
+
+
+ procedure Selection
+ (Owner : in FLTK.Widgets.Widget'Class;
+ Text : in String) is
+ begin
+ fl_static_selection
+ (Wrapper (Owner).Void_Ptr,
+ Interfaces.C.To_C (Text),
+ Text'Length);
+ end Selection;
+
+
+
+
+ function Get_Drag_Drop_Text_Support
+ return Boolean is
+ begin
+ return fl_static_get_dnd_text_ops /= 0;
+ end Get_Drag_Drop_Text_Support;
+
+
+ procedure Set_Drag_Drop_Text_Support
+ (To : in Boolean) is
+ begin
+ fl_static_set_dnd_text_ops (Boolean'Pos (To));
+ end Set_Drag_Drop_Text_Support;
+
+
+
+
+ function Has_Visible_Focus
+ return Boolean is
+ begin
+ return fl_static_get_visible_focus /= 0;
+ end Has_Visible_Focus;
+
+
+ procedure Set_Visible_Focus
+ (To : in Boolean) is
+ begin
+ fl_static_set_visible_focus (Boolean'Pos (To));
+ end Set_Visible_Focus;
+
+
+
+
+ procedure Default_Window_Close
+ (Item : in out FLTK.Widgets.Widget'Class) is
+ begin
+ fl_static_default_atclose (Wrapper (Item).Void_Ptr);
+ end Default_Window_Close;
+
+
+ function Get_First_Window
+ return access FLTK.Widgets.Groups.Windows.Window'Class
+ is
+ First_Ptr : Storage.Integer_Address := fl_static_get_first_window;
+ Actual_First : access FLTK.Widgets.Groups.Windows.Window'Class;
+ begin
+ if First_Ptr /= Null_Pointer then
+ First_Ptr := fl_widget_get_user_data (First_Ptr);
+ pragma Assert (First_Ptr /= Null_Pointer);
+ Actual_First := Window_Convert.To_Pointer (Storage.To_Address (First_Ptr));
+ end if;
+ return Actual_First;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_First_Window;
+
+
+ procedure Set_First_Window
+ (To : in FLTK.Widgets.Groups.Windows.Window'Class) is
+ begin
+ fl_static_set_first_window (Wrapper (To).Void_Ptr);
+ end Set_First_Window;
+
+
+ function Get_Next_Window
+ (From : in FLTK.Widgets.Groups.Windows.Window'Class)
+ return access FLTK.Widgets.Groups.Windows.Window'Class
+ is
+ Next_Ptr : Storage.Integer_Address := fl_static_next_window (Wrapper (From).Void_Ptr);
+ Actual_Next : access FLTK.Widgets.Groups.Windows.Window'Class;
+ begin
+ if Next_Ptr /= Null_Pointer then
+ Next_Ptr := fl_widget_get_user_data (Next_Ptr);
+ pragma Assert (Next_Ptr /= Null_Pointer);
+ Actual_Next := Window_Convert.To_Pointer (Storage.To_Address (Next_Ptr));
+ end if;
+ return Actual_Next;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Next_Window;
+
+
+ function Get_Top_Modal
+ return access FLTK.Widgets.Groups.Windows.Window'Class
+ is
+ Modal_Ptr : Storage.Integer_Address := fl_static_modal;
+ Actual_Modal : access FLTK.Widgets.Groups.Windows.Window'Class;
+ begin
+ if Modal_Ptr /= Null_Pointer then
+ Modal_Ptr := fl_widget_get_user_data (Modal_Ptr);
+ pragma Assert (Modal_Ptr /= Null_Pointer);
+ Actual_Modal := Window_Convert.To_Pointer (Storage.To_Address (Modal_Ptr));
+ end if;
+ return Actual_Modal;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Top_Modal;
+
+
+
+
+ function Read_Queue
+ return access FLTK.Widgets.Widget'Class
+ is
+ Queue_Ptr : Storage.Integer_Address := fl_static_readqueue;
+ Actual_Queue : access FLTK.Widgets.Widget'Class;
+ begin
+ if Queue_Ptr /= Null_Pointer then
+ Queue_Ptr := fl_widget_get_user_data (Queue_Ptr);
+ pragma Assert (Queue_Ptr /= Null_Pointer);
+ Actual_Queue := Widget_Convert.To_Pointer (Storage.To_Address (Queue_Ptr));
+ end if;
+ return Actual_Queue;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Read_Queue;
+
+
+
+
+ function Get_Scheme
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_static_get_scheme;
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Get_Scheme;
+
+
+ procedure Set_Scheme
+ (To : in String) is
+ begin
+ fl_static_set_scheme (Interfaces.C.To_C (To));
+ end Set_Scheme;
+
+
+ function Is_Scheme
+ (Scheme : in String)
+ return Boolean is
+ begin
+ return fl_static_is_scheme (Interfaces.C.To_C (Scheme)) /= 0;
+ end Is_Scheme;
+
+
+
+
+ function Get_Option
+ (Opt : in Option)
+ return Boolean is
+ begin
+ return fl_static_get_option (Option'Pos (Opt)) /= 0;
+ end Get_Option;
+
+
+ procedure Set_Option
+ (Opt : in Option;
+ To : in Boolean) is
+ begin
+ fl_static_set_option (Option'Pos (Opt), Boolean'Pos (To));
+ end Set_Option;
+
+
+
+
+ function Get_Default_Scrollbar_Size
+ return Natural is
+ begin
+ return Natural (fl_static_get_scrollbar_size);
+ end Get_Default_Scrollbar_Size;
+
+
+ procedure Set_Default_Scrollbar_Size
+ (To : in Natural) is
+ begin
+ fl_static_set_scrollbar_size (Interfaces.C.int (To));
+ end Set_Default_Scrollbar_Size;
+
+
+begin
+
+
+ fl_static_add_clipboard_notify
+ (Storage.To_Integer (Clipboard_Notify_Hook'Address), Null_Pointer);
+
+
+end FLTK.Static;
+
diff --git a/body/fltk-static_callback_conversions.adb b/body/fltk-static_callback_conversions.adb
new file mode 100644
index 0000000..ceb0e62
--- /dev/null
+++ b/body/fltk-static_callback_conversions.adb
@@ -0,0 +1,176 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Unchecked_Conversion,
+ FLTK.Static;
+
+use type
+
+ FLTK.Static.Awake_Handler,
+ FLTK.Static.Timeout_Handler,
+ FLTK.Static.Idle_Handler,
+ FLTK.Static.Clipboard_Notify_Handler,
+ FLTK.Static.File_Handler;
+
+
+package body FLTK.Static_Callback_Conversions is
+
+
+ function To_Awake_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Static.Awake_Handler
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (Storage.Integer_Address, FLTK.Static.Awake_Handler);
+ begin
+ if Addy = Null_Pointer then
+ return null;
+ else
+ return Raw (Addy);
+ end if;
+ end To_Awake_Access;
+
+
+ function To_Address
+ (Call : in FLTK.Static.Awake_Handler)
+ return Storage.Integer_Address
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (FLTK.Static.Awake_Handler, Storage.Integer_Address);
+ begin
+ if Call = null then
+ return Null_Pointer;
+ else
+ return Raw (Call);
+ end if;
+ end To_Address;
+
+
+ function To_Timeout_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Static.Timeout_Handler
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (Storage.Integer_Address, FLTK.Static.Timeout_Handler);
+ begin
+ if Addy = Null_Pointer then
+ return null;
+ else
+ return Raw (Addy);
+ end if;
+ end To_Timeout_Access;
+
+
+ function To_Address
+ (Call : in FLTK.Static.Timeout_Handler)
+ return Storage.Integer_Address
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (FLTK.Static.Timeout_Handler, Storage.Integer_Address);
+ begin
+ if Call = null then
+ return Null_Pointer;
+ else
+ return Raw (Call);
+ end if;
+ end To_Address;
+
+
+ function To_Idle_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Static.Idle_Handler
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (Storage.Integer_Address, FLTK.Static.Idle_Handler);
+ begin
+ if Addy = Null_Pointer then
+ return null;
+ else
+ return Raw (Addy);
+ end if;
+ end To_Idle_Access;
+
+
+ function To_Address
+ (Call : in FLTK.Static.Idle_Handler)
+ return Storage.Integer_Address
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (FLTK.Static.Idle_Handler, Storage.Integer_Address);
+ begin
+ if Call = null then
+ return Null_Pointer;
+ else
+ return Raw (Call);
+ end if;
+ end To_Address;
+
+
+ function To_Clipboard_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Static.Clipboard_Notify_Handler
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (Storage.Integer_Address, FLTK.Static.Clipboard_Notify_Handler);
+ begin
+ if Addy = Null_Pointer then
+ return null;
+ else
+ return Raw (Addy);
+ end if;
+ end To_Clipboard_Access;
+
+
+ function To_Address
+ (Call : in FLTK.Static.Clipboard_Notify_Handler)
+ return Storage.Integer_Address
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (FLTK.Static.Clipboard_Notify_Handler, Storage.Integer_Address);
+ begin
+ if Call = null then
+ return Null_Pointer;
+ else
+ return Raw (Call);
+ end if;
+ end To_Address;
+
+
+ function To_File_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Static.File_Handler
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (Storage.Integer_Address, FLTK.Static.File_Handler);
+ begin
+ if Addy = Null_Pointer then
+ return null;
+ else
+ return Raw (Addy);
+ end if;
+ end To_File_Access;
+
+
+ function To_Address
+ (Call : in FLTK.Static.File_Handler)
+ return Storage.Integer_Address
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (FLTK.Static.File_Handler, Storage.Integer_Address);
+ begin
+ if Call = null then
+ return Null_Pointer;
+ else
+ return Raw (Call);
+ end if;
+ end To_Address;
+
+
+end FLTK.Static_Callback_Conversions;
+
+
diff --git a/body/fltk-static_callback_conversions.ads b/body/fltk-static_callback_conversions.ads
new file mode 100644
index 0000000..1e10c03
--- /dev/null
+++ b/body/fltk-static_callback_conversions.ads
@@ -0,0 +1,58 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+limited with
+
+ FLTK.Static;
+
+
+private package FLTK.Static_Callback_Conversions is
+
+
+ function To_Awake_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Static.Awake_Handler;
+
+ function To_Address
+ (Call : in FLTK.Static.Awake_Handler)
+ return Storage.Integer_Address;
+
+ function To_Timeout_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Static.Timeout_Handler;
+
+ function To_Address
+ (Call : in FLTK.Static.Timeout_Handler)
+ return Storage.Integer_Address;
+
+ function To_Idle_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Static.Idle_Handler;
+
+ function To_Address
+ (Call : in FLTK.Static.Idle_Handler)
+ return Storage.Integer_Address;
+
+ function To_Clipboard_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Static.Clipboard_Notify_Handler;
+
+ function To_Address
+ (Call : in FLTK.Static.Clipboard_Notify_Handler)
+ return Storage.Integer_Address;
+
+ function To_File_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Static.File_Handler;
+
+ function To_Address
+ (Call : in FLTK.Static.File_Handler)
+ return Storage.Integer_Address;
+
+
+end FLTK.Static_Callback_Conversions;
+
+
diff --git a/body/fltk-text_buffers.adb b/body/fltk-text_buffers.adb
new file mode 100644
index 0000000..1afa2a7
--- /dev/null
+++ b/body/fltk-text_buffers.adb
@@ -0,0 +1,1352 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings,
+ Ada.Strings.Unbounded,
+ Ada.Containers;
+
+use
+
+ Ada.Strings.Unbounded;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr,
+ Ada.Containers.Count_Type;
+
+
+package body FLTK.Text_Buffers is
+
+
+ function strerror
+ (Errnum : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, strerror, "strerror");
+
+
+
+
+ function new_fl_text_buffer
+ (RS, PGS : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_text_buffer, "new_fl_text_buffer");
+ pragma Inline (new_fl_text_buffer);
+
+ procedure free_fl_text_buffer
+ (TB : in Storage.Integer_Address);
+ pragma Import (C, free_fl_text_buffer, "free_fl_text_buffer");
+ pragma Inline (free_fl_text_buffer);
+
+
+
+
+ procedure fl_text_buffer_add_modify_callback
+ (TB, CB, UD : in Storage.Integer_Address);
+ pragma Import (C, fl_text_buffer_add_modify_callback,
+ "fl_text_buffer_add_modify_callback");
+ pragma Inline (fl_text_buffer_add_modify_callback);
+
+ procedure fl_text_buffer_add_predelete_callback
+ (TB, CB, UD : in Storage.Integer_Address);
+ pragma Import (C, fl_text_buffer_add_predelete_callback,
+ "fl_text_buffer_add_predelete_callback");
+ pragma Inline (fl_text_buffer_add_predelete_callback);
+
+ procedure fl_text_buffer_call_modify_callbacks
+ (TB : in Storage.Integer_Address);
+ pragma Import (C, fl_text_buffer_call_modify_callbacks,
+ "fl_text_buffer_call_modify_callbacks");
+ pragma Inline (fl_text_buffer_call_modify_callbacks);
+
+ procedure fl_text_buffer_call_predelete_callbacks
+ (TB : in Storage.Integer_Address);
+ pragma Import (C, fl_text_buffer_call_predelete_callbacks,
+ "fl_text_buffer_call_predelete_callbacks");
+ pragma Inline (fl_text_buffer_call_predelete_callbacks);
+
+
+
+
+ function fl_text_buffer_loadfile
+ (TB : in Storage.Integer_Address;
+ N : in Interfaces.C.char_array;
+ B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_loadfile, "fl_text_buffer_loadfile");
+ pragma Inline (fl_text_buffer_loadfile);
+
+ function fl_text_buffer_appendfile
+ (TB : in Storage.Integer_Address;
+ N : in Interfaces.C.char_array;
+ B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_appendfile, "fl_text_buffer_appendfile");
+ pragma Inline (fl_text_buffer_appendfile);
+
+ function fl_text_buffer_insertfile
+ (TB : in Storage.Integer_Address;
+ N : in Interfaces.C.char_array;
+ P, B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_insertfile, "fl_text_buffer_insertfile");
+ pragma Inline (fl_text_buffer_insertfile);
+
+ function fl_text_buffer_outputfile
+ (TB : in Storage.Integer_Address;
+ N : in Interfaces.C.char_array;
+ F, T : in Interfaces.C.int;
+ B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_outputfile, "fl_text_buffer_outputfile");
+ pragma Inline (fl_text_buffer_outputfile);
+
+ function fl_text_buffer_savefile
+ (TB : in Storage.Integer_Address;
+ N : in Interfaces.C.char_array;
+ B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_savefile, "fl_text_buffer_savefile");
+ pragma Inline (fl_text_buffer_savefile);
+
+
+
+
+ procedure fl_text_buffer_insert
+ (TB : in Storage.Integer_Address;
+ P : in Interfaces.C.int;
+ I : in Interfaces.C.char_array);
+ pragma Import (C, fl_text_buffer_insert, "fl_text_buffer_insert");
+ pragma Inline (fl_text_buffer_insert);
+
+ procedure fl_text_buffer_append
+ (TB : in Storage.Integer_Address;
+ I : in Interfaces.C.char_array);
+ pragma Import (C, fl_text_buffer_append, "fl_text_buffer_append");
+ pragma Inline (fl_text_buffer_append);
+
+ procedure fl_text_buffer_replace
+ (TB : in Storage.Integer_Address;
+ S, F : in Interfaces.C.int;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_text_buffer_replace, "fl_text_buffer_replace");
+ pragma Inline (fl_text_buffer_replace);
+
+ procedure fl_text_buffer_remove
+ (TB : in Storage.Integer_Address;
+ S, F : in Interfaces.C.int);
+ pragma Import (C, fl_text_buffer_remove, "fl_text_buffer_remove");
+ pragma Inline (fl_text_buffer_remove);
+
+ function fl_text_buffer_get_text
+ (TB : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_text_buffer_get_text, "fl_text_buffer_get_text");
+ pragma Inline (fl_text_buffer_get_text);
+
+ procedure fl_text_buffer_set_text
+ (TB : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_text_buffer_set_text, "fl_text_buffer_set_text");
+ pragma Inline (fl_text_buffer_set_text);
+
+ function fl_text_buffer_byte_at
+ (TB : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.char;
+ pragma Import (C, fl_text_buffer_byte_at, "fl_text_buffer_byte_at");
+ pragma Inline (fl_text_buffer_byte_at);
+
+ function fl_text_buffer_char_at
+ (TB : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_text_buffer_char_at, "fl_text_buffer_char_at");
+ pragma Inline (fl_text_buffer_char_at);
+
+ function fl_text_buffer_text_range
+ (TB : in Storage.Integer_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");
+ pragma Inline (fl_text_buffer_text_range);
+
+ function fl_text_buffer_next_char
+ (TB : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_next_char, "fl_text_buffer_next_char");
+ pragma Inline (fl_text_buffer_next_char);
+
+ function fl_text_buffer_prev_char
+ (TB : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_prev_char, "fl_text_buffer_prev_char");
+ pragma Inline (fl_text_buffer_prev_char);
+
+
+
+
+ function fl_text_buffer_count_displayed_characters
+ (TB : in Storage.Integer_Address;
+ S, F : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_count_displayed_characters,
+ "fl_text_buffer_count_displayed_characters");
+ pragma Inline (fl_text_buffer_count_displayed_characters);
+
+ function fl_text_buffer_count_lines
+ (TB : in Storage.Integer_Address;
+ S, F : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_count_lines, "fl_text_buffer_count_lines");
+ pragma Inline (fl_text_buffer_count_lines);
+
+ function fl_text_buffer_length
+ (TB : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_length, "fl_text_buffer_length");
+ pragma Inline (fl_text_buffer_length);
+
+ function fl_text_buffer_get_tab_distance
+ (TB : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_get_tab_distance, "fl_text_buffer_get_tab_distance");
+ pragma Inline (fl_text_buffer_get_tab_distance);
+
+ procedure fl_text_buffer_set_tab_distance
+ (TB : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_text_buffer_set_tab_distance, "fl_text_buffer_set_tab_distance");
+ pragma Inline (fl_text_buffer_set_tab_distance);
+
+
+
+
+ function fl_text_buffer_selection_position
+ (TB : in Storage.Integer_Address;
+ S, E : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_selection_position, "fl_text_buffer_selection_position");
+ pragma Inline (fl_text_buffer_selection_position);
+
+ function fl_text_buffer_secondary_selection_position
+ (TB : in Storage.Integer_Address;
+ S, E : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_secondary_selection_position,
+ "fl_text_buffer_secondary_selection_position");
+ pragma Inline (fl_text_buffer_secondary_selection_position);
+
+ procedure fl_text_buffer_select
+ (TB : in Storage.Integer_Address;
+ S, E : in Interfaces.C.int);
+ pragma Import (C, fl_text_buffer_select, "fl_text_buffer_select");
+ pragma Inline (fl_text_buffer_select);
+
+ procedure fl_text_buffer_secondary_select
+ (TB : in Storage.Integer_Address;
+ S, E : in Interfaces.C.int);
+ pragma Import (C, fl_text_buffer_secondary_select, "fl_text_buffer_secondary_select");
+ pragma Inline (fl_text_buffer_secondary_select);
+
+ function fl_text_buffer_selected
+ (TB : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_selected, "fl_text_buffer_selected");
+ pragma Inline (fl_text_buffer_selected);
+
+ function fl_text_buffer_secondary_selected
+ (TB : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_secondary_selected, "fl_text_buffer_secondary_selected");
+ pragma Inline (fl_text_buffer_secondary_selected);
+
+ function fl_text_buffer_selection_text
+ (TB : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_text_buffer_selection_text, "fl_text_buffer_selection_text");
+ pragma Inline (fl_text_buffer_selection_text);
+
+ function fl_text_buffer_secondary_selection_text
+ (TB : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_text_buffer_secondary_selection_text,
+ "fl_text_buffer_secondary_selection_text");
+ pragma Inline (fl_text_buffer_secondary_selection_text);
+
+ procedure fl_text_buffer_replace_selection
+ (TB : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_text_buffer_replace_selection, "fl_text_buffer_replace_selection");
+ pragma Inline (fl_text_buffer_replace_selection);
+
+ procedure fl_text_buffer_replace_secondary_selection
+ (TB : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_text_buffer_replace_secondary_selection,
+ "fl_text_buffer_replace_secondary_selection");
+ pragma Inline (fl_text_buffer_replace_secondary_selection);
+
+ procedure fl_text_buffer_remove_selection
+ (TB : in Storage.Integer_Address);
+ pragma Import (C, fl_text_buffer_remove_selection, "fl_text_buffer_remove_selection");
+ pragma Inline (fl_text_buffer_remove_selection);
+
+ procedure fl_text_buffer_remove_secondary_selection
+ (TB : in Storage.Integer_Address);
+ pragma Import (C, fl_text_buffer_remove_secondary_selection,
+ "fl_text_buffer_remove_secondary_selection");
+ pragma Inline (fl_text_buffer_remove_secondary_selection);
+
+ procedure fl_text_buffer_unselect
+ (TB : in Storage.Integer_Address);
+ pragma Import (C, fl_text_buffer_unselect, "fl_text_buffer_unselect");
+ pragma Inline (fl_text_buffer_unselect);
+
+ procedure fl_text_buffer_secondary_unselect
+ (TB : in Storage.Integer_Address);
+ pragma Import (C, fl_text_buffer_secondary_unselect, "fl_text_buffer_secondary_unselect");
+ pragma Inline (fl_text_buffer_secondary_unselect);
+
+
+
+
+ procedure fl_text_buffer_highlight
+ (TB : in Storage.Integer_Address;
+ F, T : in Interfaces.C.int);
+ pragma Import (C, fl_text_buffer_highlight, "fl_text_buffer_highlight");
+ pragma Inline (fl_text_buffer_highlight);
+
+ function fl_text_buffer_highlight_text
+ (TB : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_text_buffer_highlight_text, "fl_text_buffer_highlight_text");
+ pragma Inline (fl_text_buffer_highlight_text);
+
+ procedure fl_text_buffer_unhighlight
+ (TB : in Storage.Integer_Address);
+ pragma Import (C, fl_text_buffer_unhighlight, "fl_text_buffer_unhighlight");
+ pragma Inline (fl_text_buffer_unhighlight);
+
+
+
+
+ function fl_text_buffer_findchar_forward
+ (TB : in Storage.Integer_Address;
+ SP : in Interfaces.C.int;
+ IT : in Interfaces.C.unsigned;
+ FP : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_findchar_forward, "fl_text_buffer_findchar_forward");
+ pragma Inline (fl_text_buffer_findchar_forward);
+
+ function fl_text_buffer_findchar_backward
+ (TB : in Storage.Integer_Address;
+ SP : in Interfaces.C.int;
+ IT : in Interfaces.C.unsigned;
+ FP : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_findchar_backward, "fl_text_buffer_findchar_backward");
+ pragma Inline (fl_text_buffer_findchar_backward);
+
+ function fl_text_buffer_search_forward
+ (TB : in Storage.Integer_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");
+ pragma Inline (fl_text_buffer_search_forward);
+
+ function fl_text_buffer_search_backward
+ (TB : in Storage.Integer_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");
+ pragma Inline (fl_text_buffer_search_backward);
+
+
+
+
+ function fl_text_buffer_word_start
+ (TB : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_word_start, "fl_text_buffer_word_start");
+ pragma Inline (fl_text_buffer_word_start);
+
+ function fl_text_buffer_word_end
+ (TB : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_word_end, "fl_text_buffer_word_end");
+ pragma Inline (fl_text_buffer_word_end);
+
+ function fl_text_buffer_line_start
+ (TB : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_line_start, "fl_text_buffer_line_start");
+ pragma Inline (fl_text_buffer_line_start);
+
+ function fl_text_buffer_line_end
+ (TB : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_line_end, "fl_text_buffer_line_end");
+ pragma Inline (fl_text_buffer_line_end);
+
+ function fl_text_buffer_line_text
+ (TB : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_text_buffer_line_text, "fl_text_buffer_line_text");
+ pragma Inline (fl_text_buffer_line_text);
+
+ function fl_text_buffer_skip_lines
+ (TB : in Storage.Integer_Address;
+ S, L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_skip_lines, "fl_text_buffer_skip_lines");
+ pragma Inline (fl_text_buffer_skip_lines);
+
+ function fl_text_buffer_rewind_lines
+ (TB : in Storage.Integer_Address;
+ S, L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_rewind_lines, "fl_text_buffer_rewind_lines");
+ pragma Inline (fl_text_buffer_rewind_lines);
+
+ function fl_text_buffer_skip_displayed_characters
+ (TB : in Storage.Integer_Address;
+ S, N : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_skip_displayed_characters,
+ "fl_text_buffer_skip_displayed_characters");
+ pragma Inline (fl_text_buffer_skip_displayed_characters);
+
+
+
+
+ procedure fl_text_buffer_canundo
+ (TB : in Storage.Integer_Address;
+ F : in Interfaces.C.char);
+ pragma Import (C, fl_text_buffer_canundo, "fl_text_buffer_canundo");
+ pragma Inline (fl_text_buffer_canundo);
+
+ procedure fl_text_buffer_copy
+ (TB, TB2 : in Storage.Integer_Address;
+ S, F, I : in Interfaces.C.int);
+ pragma Import (C, fl_text_buffer_copy, "fl_text_buffer_copy");
+ pragma Inline (fl_text_buffer_copy);
+
+ function fl_text_buffer_utf8_align
+ (TB : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_buffer_utf8_align, "fl_text_buffer_utf8_align");
+ pragma Inline (fl_text_buffer_utf8_align);
+
+
+
+
+ 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 Storage.Integer_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 (Storage.To_Address (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 Storage.Integer_Address)
+ is
+ Place : Position := Position (Pos);
+ Length : Natural := Natural (Deleted);
+
+ Ada_Text_Buffer : access Text_Buffer :=
+ Text_Buffer_Convert.To_Pointer (Storage.To_Address (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;
+
+
+
+
+ procedure Finalize
+ (This : in out Text_Buffer) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_text_buffer (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ package body Forge is
+
+ 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));
+ fl_text_buffer_add_modify_callback
+ (This.Void_Ptr,
+ Storage.To_Integer (Modify_Callback_Hook'Address),
+ Storage.To_Integer (This'Address));
+ fl_text_buffer_add_predelete_callback
+ (This.Void_Ptr,
+ Storage.To_Integer (Predelete_Callback_Hook'Address),
+ Storage.To_Integer (This'Address));
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ procedure Add_Modify_Callback
+ (This : in out Text_Buffer;
+ Func : in Modify_Callback) is
+ begin
+ This.Modify_CBs.Append (Func);
+ end Add_Modify_Callback;
+
+
+ procedure Add_Predelete_Callback
+ (This : in out Text_Buffer;
+ Func : in Predelete_Callback) is
+ begin
+ This.Predelete_CBs.Append (Func);
+ end Add_Predelete_Callback;
+
+
+ procedure Remove_Modify_Callback
+ (This : in out Text_Buffer;
+ Func : in Modify_Callback) is
+ begin
+ for I in reverse This.Modify_CBs.First_Index .. This.Modify_CBs.Last_Index loop
+ if This.Modify_CBs.Element (I) = Func then
+ This.Modify_CBs.Delete (I);
+ return;
+ end if;
+ end loop;
+ end Remove_Modify_Callback;
+
+
+ procedure Remove_Predelete_Callback
+ (This : in out Text_Buffer;
+ Func : in Predelete_Callback) is
+ begin
+ for I in reverse This.Predelete_CBs.First_Index .. This.Predelete_CBs.Last_Index loop
+ if This.Predelete_CBs.Element (I) = Func then
+ This.Predelete_CBs.Delete (I);
+ return;
+ end if;
+ end loop;
+ end Remove_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 Load_File
+ (This : in out Text_Buffer;
+ Name : in String;
+ Buffer : in Natural := 128 * 1024)
+ is
+ Err_No : Interfaces.C.int := fl_text_buffer_loadfile
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Name),
+ Interfaces.C.int (Buffer));
+ begin
+ if Err_No /= 0 then
+ raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No));
+ end if;
+ end Load_File;
+
+
+ procedure Append_File
+ (This : in out Text_Buffer;
+ Name : in String;
+ Buffer : in Natural := 128 * 1024)
+ is
+ Err_No : Interfaces.C.int := fl_text_buffer_appendfile
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Name),
+ Interfaces.C.int (Buffer));
+ begin
+ if Err_No /= 0 then
+ raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No));
+ end if;
+ end Append_File;
+
+
+ procedure Insert_File
+ (This : in out Text_Buffer;
+ Name : in String;
+ Place : in Position;
+ Buffer : in Natural := 128 * 1024)
+ is
+ Err_No : Interfaces.C.int := fl_text_buffer_insertfile
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Name),
+ Interfaces.C.int (Place),
+ Interfaces.C.int (Buffer));
+ begin
+ if Err_No /= 0 then
+ raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No));
+ end if;
+ end Insert_File;
+
+
+ procedure Output_File
+ (This : in Text_Buffer;
+ Name : in String;
+ Start, Finish : in Position;
+ Buffer : in Natural := 128 * 1024)
+ is
+ Err_No : Interfaces.C.int := fl_text_buffer_outputfile
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Name),
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish),
+ Interfaces.C.int (Buffer));
+ begin
+ if Err_No /= 0 then
+ raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No));
+ end if;
+ end Output_File;
+
+
+ procedure Save_File
+ (This : in Text_Buffer;
+ Name : in String;
+ Buffer : in Natural := 128 * 1024)
+ is
+ Err_No : Interfaces.C.int := fl_text_buffer_savefile
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Name),
+ Interfaces.C.int (Buffer));
+ begin
+ if Err_No /= 0 then
+ raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No));
+ end if;
+ end Save_File;
+
+
+
+
+ procedure Insert_Text
+ (This : in out Text_Buffer;
+ Place : in Position;
+ Text : in String) is
+ begin
+ fl_text_buffer_insert
+ (This.Void_Ptr,
+ Interfaces.C.int (Place),
+ Interfaces.C.To_C (Text));
+ end Insert_Text;
+
+
+ procedure Append_Text
+ (This : in out Text_Buffer;
+ Text : in String) is
+ begin
+ fl_text_buffer_append
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text));
+ end Append_Text;
+
+
+ procedure Replace_Text
+ (This : in out Text_Buffer;
+ Start, Finish : in Position;
+ Text : in String) is
+ begin
+ fl_text_buffer_replace
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish),
+ Interfaces.C.To_C (Text));
+ end Replace_Text;
+
+
+ procedure Remove_Text
+ (This : in out Text_Buffer;
+ Start, Finish : in Position) is
+ begin
+ fl_text_buffer_remove
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish));
+ end Remove_Text;
+
+
+ function Get_Entire_Text
+ (This : in Text_Buffer)
+ return String
+ is
+ Raw : Interfaces.C.Strings.chars_ptr :=
+ fl_text_buffer_get_text (This.Void_Ptr);
+ begin
+ if Raw = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ declare
+ Ada_String : String := Interfaces.C.Strings.Value (Raw);
+ begin
+ Interfaces.C.Strings.Free (Raw);
+ return Ada_String;
+ end;
+ end if;
+ end Get_Entire_Text;
+
+
+ procedure Set_Entire_Text
+ (This : in out Text_Buffer;
+ Text : in String) is
+ begin
+ fl_text_buffer_set_text (This.Void_Ptr, Interfaces.C.To_C (Text));
+ end Set_Entire_Text;
+
+
+ function Byte_At
+ (This : in Text_Buffer;
+ Place : in Position)
+ return Character is
+ begin
+ return Character'Val (Interfaces.C.char'Pos
+ (fl_text_buffer_byte_at (This.Void_Ptr, Interfaces.C.int (Place))));
+ end Byte_At;
+
+
+ function Character_At
+ (This : in Text_Buffer;
+ Place : in Position)
+ return Character is
+ begin
+ return Character'Val (fl_text_buffer_char_at
+ (This.Void_Ptr,
+ Interfaces.C.int (Place)));
+ end Character_At;
+
+
+ function Text_At
+ (This : in Text_Buffer;
+ Start, Finish : in Position)
+ 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));
+ begin
+ if C_Str = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ declare
+ The_Text : String := Interfaces.C.Strings.Value (C_Str);
+ begin
+ Interfaces.C.Strings.Free (C_Str);
+ return The_Text;
+ end;
+ end if;
+ end Text_At;
+
+
+ function Next_Char
+ (This : in Text_Buffer;
+ Place : in Position)
+ return Character is
+ begin
+ return Character'Val (fl_text_buffer_next_char
+ (This.Void_Ptr,
+ Interfaces.C.int (Place)));
+ end Next_Char;
+
+
+ function Prev_Char
+ (This : in Text_Buffer;
+ Place : in Position)
+ return Character is
+ begin
+ return Character'Val (fl_text_buffer_prev_char
+ (This.Void_Ptr,
+ Interfaces.C.int (Place)));
+ end Prev_Char;
+
+
+
+
+ function Count_Displayed_Characters
+ (This : in Text_Buffer;
+ Start, Finish : in Position)
+ return Integer is
+ begin
+ return Integer (fl_text_buffer_count_displayed_characters
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish)));
+ end Count_Displayed_Characters;
+
+
+ function Count_Lines
+ (This : in Text_Buffer;
+ Start, Finish : in Position)
+ return Integer is
+ begin
+ return Integer (fl_text_buffer_count_lines
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish)));
+ end Count_Lines;
+
+
+ function Length
+ (This : in Text_Buffer)
+ return Natural is
+ begin
+ return Natural (fl_text_buffer_length (This.Void_Ptr));
+ end Length;
+
+
+ function Get_Tab_Width
+ (This : in Text_Buffer)
+ return Natural is
+ begin
+ return Natural (fl_text_buffer_get_tab_distance (This.Void_Ptr));
+ end Get_Tab_Width;
+
+
+ procedure Set_Tab_Width
+ (This : in out Text_Buffer;
+ To : in Natural) is
+ begin
+ fl_text_buffer_set_tab_distance (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Tab_Width;
+
+
+
+
+ function Get_Selection
+ (This : in Text_Buffer;
+ Start, Finish : out Position)
+ return Boolean
+ is
+ S, F : Interfaces.C.int;
+ begin
+ if fl_text_buffer_selection_position (This.Void_Ptr, S, F) /= 0 then
+ Start := Position (S);
+ Finish := Position (F);
+ return True;
+ else
+ return False;
+ end if;
+ end Get_Selection;
+
+
+ function Get_Secondary_Selection
+ (This : in Text_Buffer;
+ Start, Finish : out Position)
+ return Boolean
+ is
+ S, F : Interfaces.C.int;
+ begin
+ if fl_text_buffer_secondary_selection_position (This.Void_Ptr, S, F) /= 0 then
+ Start := Position (S);
+ Finish := Position (F);
+ return True;
+ else
+ return False;
+ end if;
+ end Get_Secondary_Selection;
+
+
+ procedure Set_Selection
+ (This : in out Text_Buffer;
+ Start, Finish : in Position) is
+ begin
+ fl_text_buffer_select
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish));
+ end Set_Selection;
+
+
+ procedure Set_Secondary_Selection
+ (This : in out Text_Buffer;
+ Start, Finish : in Position) is
+ begin
+ fl_text_buffer_secondary_select
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish));
+ end Set_Secondary_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 Has_Secondary_Selection
+ (This : in Text_Buffer)
+ return Boolean is
+ begin
+ return fl_text_buffer_secondary_selected (This.Void_Ptr) /= 0;
+ end Has_Secondary_Selection;
+
+
+ function Selection_Text
+ (This : in Text_Buffer)
+ return String
+ is
+ Raw : Interfaces.C.Strings.chars_ptr :=
+ fl_text_buffer_selection_text (This.Void_Ptr);
+ begin
+ if Raw = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ declare
+ Ada_String : String := Interfaces.C.Strings.Value (Raw);
+ begin
+ Interfaces.C.Strings.Free (Raw);
+ return Ada_String;
+ end;
+ end if;
+ end Selection_Text;
+
+
+ function Secondary_Selection_Text
+ (This : in Text_Buffer)
+ return String
+ is
+ Raw : Interfaces.C.Strings.chars_ptr :=
+ fl_text_buffer_secondary_selection_text (This.Void_Ptr);
+ begin
+ if Raw = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ declare
+ Ada_String : String := Interfaces.C.Strings.Value (Raw);
+ begin
+ Interfaces.C.Strings.Free (Raw);
+ return Ada_String;
+ end;
+ end if;
+ end Secondary_Selection_Text;
+
+
+ procedure Replace_Selection
+ (This : in out Text_Buffer;
+ Text : in String) is
+ begin
+ fl_text_buffer_replace_selection (This.Void_Ptr, Interfaces.C.To_C (Text));
+ end Replace_Selection;
+
+
+ procedure Replace_Secondary_Selection
+ (This : in out Text_Buffer;
+ Text : in String) is
+ begin
+ fl_text_buffer_replace_secondary_selection (This.Void_Ptr, Interfaces.C.To_C (Text));
+ end Replace_Secondary_Selection;
+
+
+ procedure Remove_Selection
+ (This : in out Text_Buffer) is
+ begin
+ fl_text_buffer_remove_selection (This.Void_Ptr);
+ end Remove_Selection;
+
+
+ procedure Remove_Secondary_Selection
+ (This : in out Text_Buffer) is
+ begin
+ fl_text_buffer_remove_secondary_selection (This.Void_Ptr);
+ end Remove_Secondary_Selection;
+
+
+ procedure Unselect
+ (This : in out Text_Buffer) is
+ begin
+ fl_text_buffer_unselect (This.Void_Ptr);
+ end Unselect;
+
+
+ procedure Secondary_Unselect
+ (This : in out Text_Buffer) is
+ begin
+ fl_text_buffer_secondary_unselect (This.Void_Ptr);
+ end Secondary_Unselect;
+
+
+
+
+ procedure Get_Highlight
+ (This : in Text_Buffer;
+ Start, Finish : out Position) is
+ begin
+ Start := This.High_From;
+ Finish := This.High_To;
+ end Get_Highlight;
+
+
+ procedure Set_Highlight
+ (This : in out Text_Buffer;
+ Start, Finish : in Position) is
+ begin
+ This.High_From := Start;
+ This.High_To := Finish;
+ fl_text_buffer_highlight
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish));
+ end Set_Highlight;
+
+
+ function Get_Highlighted_Text
+ (This : in Text_Buffer)
+ return String
+ is
+ Raw : Interfaces.C.Strings.chars_ptr :=
+ fl_text_buffer_highlight_text (This.Void_Ptr);
+ begin
+ if Raw = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ declare
+ Ada_String : String := Interfaces.C.Strings.Value (Raw);
+ begin
+ Interfaces.C.Strings.Free (Raw);
+ return Ada_String;
+ end;
+ end if;
+ end Get_Highlighted_Text;
+
+
+ procedure Unhighlight
+ (This : in out Text_Buffer) is
+ begin
+ fl_text_buffer_unhighlight (This.Void_Ptr);
+ end Unhighlight;
+
+
+
+
+ function Findchar_Forward
+ (This : in Text_Buffer;
+ Start_At : in Position;
+ Item : in Character;
+ Found_At : out Position)
+ return Boolean
+ is
+ Place : Interfaces.C.int;
+ begin
+ if fl_text_buffer_findchar_forward
+ (This.Void_Ptr,
+ Interfaces.C.int (Start_At),
+ Character'Pos (Item),
+ Place) /= 0
+ then
+ Found_At := Position (Place);
+ return True;
+ else
+ return False;
+ end if;
+ end Findchar_Forward;
+
+
+ function Findchar_Backward
+ (This : in Text_Buffer;
+ Start_At : in Position;
+ Item : in Character;
+ Found_At : out Position)
+ return Boolean
+ is
+ Place : Interfaces.C.int;
+ begin
+ if fl_text_buffer_findchar_backward
+ (This.Void_Ptr,
+ Interfaces.C.int (Start_At),
+ Character'Pos (Item),
+ Place) /= 0
+ then
+ Found_At := Position (Place);
+ return True;
+ else
+ return False;
+ end if;
+ end Findchar_Backward;
+
+
+ function Search_Forward
+ (This : in Text_Buffer;
+ Start_At : in Position;
+ Item : in String;
+ Found_At : out Position;
+ Match_Case : in Boolean := False)
+ return Boolean
+ is
+ Place : Interfaces.C.int;
+ begin
+ if fl_text_buffer_search_forward
+ (This.Void_Ptr,
+ Interfaces.C.int (Start_At),
+ Interfaces.C.To_C (Item),
+ Place,
+ Boolean'Pos (Match_Case)) /= 0
+ then
+ Found_At := Position (Place);
+ return True;
+ else
+ return False;
+ end if;
+ end Search_Forward;
+
+
+ function Search_Backward
+ (This : in Text_Buffer;
+ Start_At : in Position;
+ Item : in String;
+ Found_At : out Position;
+ Match_Case : in Boolean := False)
+ return Boolean
+ is
+ Place : Interfaces.C.int;
+ begin
+ if fl_text_buffer_search_backward
+ (This.Void_Ptr,
+ Interfaces.C.int (Start_At),
+ Interfaces.C.To_C (Item),
+ Place,
+ Boolean'Pos (Match_Case)) /= 0
+ then
+ Found_At := Position (Place);
+ return True;
+ else
+ return False;
+ end if;
+ end Search_Backward;
+
+
+
+
+ function Word_Start
+ (This : in Text_Buffer;
+ Place : in Position)
+ return Position is
+ begin
+ return Position (fl_text_buffer_word_start (This.Void_Ptr, Interfaces.C.int (Place)));
+ end Word_Start;
+
+
+ function Word_End
+ (This : in Text_Buffer;
+ Place : in Position)
+ return Position is
+ begin
+ return Position (fl_text_buffer_word_end (This.Void_Ptr, Interfaces.C.int (Place)));
+ end Word_End;
+
+
+ function Line_Start
+ (This : in Text_Buffer;
+ Place : in Position)
+ return Position is
+ begin
+ return Position (fl_text_buffer_line_start (This.Void_Ptr, Interfaces.C.int (Place)));
+ end Line_Start;
+
+
+ function Line_End
+ (This : in Text_Buffer;
+ Place : in Position)
+ return Position is
+ begin
+ return Position (fl_text_buffer_line_end (This.Void_Ptr, Interfaces.C.int (Place)));
+ end Line_End;
+
+
+ function Line_Text
+ (This : in Text_Buffer;
+ Place : in Position)
+ return String
+ is
+ Raw : Interfaces.C.Strings.chars_ptr := fl_text_buffer_line_text
+ (This.Void_Ptr,
+ Interfaces.C.int (Place));
+ begin
+ if Raw = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ declare
+ Ada_String : String := Interfaces.C.Strings.Value (Raw);
+ begin
+ Interfaces.C.Strings.Free (Raw);
+ return Ada_String;
+ end;
+ end if;
+ end Line_Text;
+
+
+ function Skip_Lines
+ (This : in out Text_Buffer;
+ Start : in Position;
+ Lines : in Natural)
+ return Position 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 : in Position;
+ Lines : in Natural)
+ return Position is
+ begin
+ return Natural (fl_text_buffer_rewind_lines
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Lines)));
+ end Rewind_Lines;
+
+
+ function Skip_Displayed_Characters
+ (This : in Text_Buffer;
+ Start : in Position;
+ Chars : in Natural)
+ return Position is
+ begin
+ return Natural (fl_text_buffer_skip_displayed_characters
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Chars)));
+ end Skip_Displayed_Characters;
+
+
+
+
+ procedure Can_Undo
+ (This : in out Text_Buffer;
+ Flag : in Boolean) is
+ begin
+ fl_text_buffer_canundo (This.Void_Ptr, Interfaces.C.char'Val (Boolean'Pos (Flag)));
+ end Can_Undo;
+
+
+ procedure Copy
+ (This : in out Text_Buffer;
+ From : in Text_Buffer;
+ Start, Finish : in Position;
+ Insert_Pos : in Position) is
+ begin
+ fl_text_buffer_copy
+ (This.Void_Ptr,
+ From.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish),
+ Interfaces.C.int (Insert_Pos));
+ end Copy;
+
+
+ function UTF8_Align
+ (This : in Text_Buffer;
+ Place : in Position)
+ return Position is
+ begin
+ return Position (fl_text_buffer_utf8_align (This.Void_Ptr, Interfaces.C.int (Place)));
+ end UTF8_Align;
+
+
+end FLTK.Text_Buffers;
+
diff --git a/body/fltk-tooltips.adb b/body/fltk-tooltips.adb
new file mode 100644
index 0000000..ccdb649
--- /dev/null
+++ b/body/fltk-tooltips.adb
@@ -0,0 +1,372 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C,
+ System.Address_To_Access_Conversions;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Tooltips is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function fl_tooltip_get_current
+ return Storage.Integer_Address;
+ pragma Import (C, fl_tooltip_get_current, "fl_tooltip_get_current");
+ pragma Inline (fl_tooltip_get_current);
+
+ procedure fl_tooltip_set_current
+ (I : in Storage.Integer_Address);
+ pragma Import (C, fl_tooltip_set_current, "fl_tooltip_set_current");
+ pragma Inline (fl_tooltip_set_current);
+
+ function fl_tooltip_enabled
+ return Interfaces.C.int;
+ pragma Import (C, fl_tooltip_enabled, "fl_tooltip_enabled");
+ pragma Inline (fl_tooltip_enabled);
+
+ procedure fl_tooltip_enable
+ (V : in Interfaces.C.int);
+ pragma Import (C, fl_tooltip_enable, "fl_tooltip_enable");
+ pragma Inline (fl_tooltip_enable);
+
+ procedure fl_tooltip_disable;
+ pragma Import (C, fl_tooltip_disable, "fl_tooltip_disable");
+ pragma Inline (fl_tooltip_disable);
+
+ procedure fl_tooltip_enter_area
+ (I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_tooltip_enter_area, "fl_tooltip_enter_area");
+ pragma Inline (fl_tooltip_enter_area);
+
+
+
+
+ function fl_tooltip_get_delay
+ return Interfaces.C.C_float;
+ pragma Import (C, fl_tooltip_get_delay, "fl_tooltip_get_delay");
+ pragma Inline (fl_tooltip_get_delay);
+
+ procedure fl_tooltip_set_delay
+ (V : in Interfaces.C.C_float);
+ pragma Import (C, fl_tooltip_set_delay, "fl_tooltip_set_delay");
+ pragma Inline (fl_tooltip_set_delay);
+
+ function fl_tooltip_get_hoverdelay
+ return Interfaces.C.C_float;
+ pragma Import (C, fl_tooltip_get_hoverdelay, "fl_tooltip_get_hoverdelay");
+ pragma Inline (fl_tooltip_get_hoverdelay);
+
+ procedure fl_tooltip_set_hoverdelay
+ (V : in Interfaces.C.C_float);
+ pragma Import (C, fl_tooltip_set_hoverdelay, "fl_tooltip_set_hoverdelay");
+ pragma Inline (fl_tooltip_set_hoverdelay);
+
+
+
+
+ function fl_tooltip_get_color
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_tooltip_get_color, "fl_tooltip_get_color");
+ pragma Inline (fl_tooltip_get_color);
+
+ procedure fl_tooltip_set_color
+ (V : in Interfaces.C.unsigned);
+ pragma Import (C, fl_tooltip_set_color, "fl_tooltip_set_color");
+ pragma Inline (fl_tooltip_set_color);
+
+ function fl_tooltip_get_margin_height
+ return Interfaces.C.int;
+ pragma Import (C, fl_tooltip_get_margin_height, "fl_tooltip_get_margin_height");
+ pragma Inline (fl_tooltip_get_margin_height);
+
+ procedure fl_tooltip_set_margin_height
+ (V : in Interfaces.C.int);
+ pragma Import (C, fl_tooltip_set_margin_height, "fl_tooltip_set_margin_height");
+ pragma Inline (fl_tooltip_set_margin_height);
+
+ function fl_tooltip_get_margin_width
+ return Interfaces.C.int;
+ pragma Import (C, fl_tooltip_get_margin_width, "fl_tooltip_get_margin_width");
+ pragma Inline (fl_tooltip_get_margin_width);
+
+ procedure fl_tooltip_set_margin_width
+ (V : in Interfaces.C.int);
+ pragma Import (C, fl_tooltip_set_margin_width, "fl_tooltip_set_margin_width");
+ pragma Inline (fl_tooltip_set_margin_width);
+
+ function fl_tooltip_get_wrap_width
+ return Interfaces.C.int;
+ pragma Import (C, fl_tooltip_get_wrap_width, "fl_tooltip_get_wrap_width");
+ pragma Inline (fl_tooltip_get_wrap_width);
+
+ procedure fl_tooltip_set_wrap_width
+ (V : in Interfaces.C.int);
+ pragma Import (C, fl_tooltip_set_wrap_width, "fl_tooltip_set_wrap_width");
+ pragma Inline (fl_tooltip_set_wrap_width);
+
+
+
+
+ function fl_tooltip_get_textcolor
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_tooltip_get_textcolor, "fl_tooltip_get_textcolor");
+ pragma Inline (fl_tooltip_get_textcolor);
+
+ procedure fl_tooltip_set_textcolor
+ (V : in Interfaces.C.unsigned);
+ pragma Import (C, fl_tooltip_set_textcolor, "fl_tooltip_set_textcolor");
+ pragma Inline (fl_tooltip_set_textcolor);
+
+ function fl_tooltip_get_font
+ return Interfaces.C.int;
+ pragma Import (C, fl_tooltip_get_font, "fl_tooltip_get_font");
+ pragma Inline (fl_tooltip_get_font);
+
+ procedure fl_tooltip_set_font
+ (V : in Interfaces.C.int);
+ pragma Import (C, fl_tooltip_set_font, "fl_tooltip_set_font");
+ pragma Inline (fl_tooltip_set_font);
+
+ function fl_tooltip_get_size
+ return Interfaces.C.int;
+ pragma Import (C, fl_tooltip_get_size, "fl_tooltip_get_size");
+ pragma Inline (fl_tooltip_get_size);
+
+ procedure fl_tooltip_set_size
+ (V : in Interfaces.C.int);
+ pragma Import (C, fl_tooltip_set_size, "fl_tooltip_set_size");
+ pragma Inline (fl_tooltip_set_size);
+
+
+
+
+ function fl_widget_get_user_data
+ (W : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data");
+ pragma Inline (fl_widget_get_user_data);
+
+ package Widget_Convert is new
+ System.Address_To_Access_Conversions (FLTK.Widgets.Widget'Class);
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Target
+ return access FLTK.Widgets.Widget'Class
+ is
+ Widget_Ptr : Storage.Integer_Address := fl_tooltip_get_current;
+ Actual_Widget : access FLTK.Widgets.Widget'Class;
+ begin
+ if Widget_Ptr /= Null_Pointer then
+ Widget_Ptr := fl_widget_get_user_data (Widget_Ptr);
+ pragma Assert (Widget_Ptr /= Null_Pointer);
+ Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Widget_Ptr));
+ end if;
+ return Actual_Widget;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Target;
+
+
+ procedure Set_Target
+ (To : in FLTK.Widgets.Widget'Class) is
+ begin
+ fl_tooltip_set_current (Wrapper (To).Void_Ptr);
+ end Set_Target;
+
+
+ function Is_Enabled
+ return Boolean is
+ begin
+ return fl_tooltip_enabled /= 0;
+ end Is_Enabled;
+
+
+ procedure Set_Enabled
+ (To : in Boolean := True) is
+ begin
+ fl_tooltip_enable (Boolean'Pos (To));
+ end Set_Enabled;
+
+
+ procedure Disable is
+ begin
+ fl_tooltip_disable;
+ end Disable;
+
+
+ procedure Enter_Area
+ (Item : in FLTK.Widgets.Widget'Class;
+ X, Y, W, H : in Integer;
+ Tip : in String) is
+ begin
+ fl_tooltip_enter_area
+ (Wrapper (Item).Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Tip));
+ end Enter_Area;
+
+
+
+
+ function Get_Delay
+ return Float is
+ begin
+ return Float (fl_tooltip_get_delay);
+ end Get_Delay;
+
+
+ procedure Set_Delay
+ (To : in Float) is
+ begin
+ fl_tooltip_set_delay (Interfaces.C.C_float (To));
+ end Set_Delay;
+
+
+ function Get_Hover_Delay
+ return Float is
+ begin
+ return Float (fl_tooltip_get_hoverdelay);
+ end Get_Hover_Delay;
+
+
+ procedure Set_Hover_Delay
+ (To : in Float) is
+ begin
+ fl_tooltip_set_hoverdelay (Interfaces.C.C_float (To));
+ end Set_Hover_Delay;
+
+
+
+
+ function Get_Background_Color
+ return Color is
+ begin
+ return Color (fl_tooltip_get_color);
+ end Get_Background_Color;
+
+
+ procedure Set_Background_Color
+ (To : in Color) is
+ begin
+ fl_tooltip_set_color (Interfaces.C.unsigned (To));
+ end Set_Background_Color;
+
+
+ function Get_Margin_Height
+ return Natural is
+ begin
+ return Natural (fl_tooltip_get_margin_height);
+ end Get_Margin_Height;
+
+
+ procedure Set_Margin_Height
+ (To : in Natural) is
+ begin
+ fl_tooltip_set_margin_height (Interfaces.C.int (To));
+ end Set_Margin_Height;
+
+
+ function Get_Margin_Width
+ return Natural is
+ begin
+ return Natural (fl_tooltip_get_margin_width);
+ end Get_Margin_Width;
+
+
+ procedure Set_Margin_Width
+ (To : in Natural) is
+ begin
+ fl_tooltip_set_margin_width (Interfaces.C.int (To));
+ end Set_Margin_Width;
+
+
+ function Get_Wrap_Width
+ return Natural is
+ begin
+ return Natural (fl_tooltip_get_wrap_width);
+ end Get_Wrap_Width;
+
+
+ procedure Set_Wrap_Width
+ (To : in Natural) is
+ begin
+ fl_tooltip_set_wrap_width (Interfaces.C.int (To));
+ end Set_Wrap_Width;
+
+
+
+
+ function Get_Text_Color
+ return Color is
+ begin
+ return Color (fl_tooltip_get_textcolor);
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (To : in Color) is
+ begin
+ fl_tooltip_set_textcolor (Interfaces.C.unsigned (To));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_tooltip_get_font);
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (To : in Font_Kind) is
+ begin
+ fl_tooltip_set_font (Font_Kind'Pos (To));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ return Font_Size is
+ begin
+ return Font_Size (fl_tooltip_get_size);
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (To : in Font_Size) is
+ begin
+ fl_tooltip_set_size (Interfaces.C.int (To));
+ end Set_Text_Size;
+
+
+end FLTK.Tooltips;
+
+
diff --git a/body/fltk-widget_callback_conversions.adb b/body/fltk-widget_callback_conversions.adb
new file mode 100644
index 0000000..29f920e
--- /dev/null
+++ b/body/fltk-widget_callback_conversions.adb
@@ -0,0 +1,52 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Unchecked_Conversion,
+ FLTK.Widgets;
+
+use type
+
+ FLTK.Widgets.Widget_Callback;
+
+
+package body FLTK.Widget_Callback_Conversions is
+
+
+ function To_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Widgets.Widget_Callback
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (Storage.Integer_Address, FLTK.Widgets.Widget_Callback);
+ begin
+ if Addy = Null_Pointer then
+ return null;
+ else
+ return Raw (Addy);
+ end if;
+ end To_Access;
+
+
+ function To_Address
+ (Call : in FLTK.Widgets.Widget_Callback)
+ return Storage.Integer_Address
+ is
+ function Raw is new Ada.Unchecked_Conversion
+ (FLTK.Widgets.Widget_Callback, Storage.Integer_Address);
+ begin
+ if Call = null then
+ return Null_Pointer;
+ else
+ return Raw (Call);
+ end if;
+ end To_Address;
+
+
+end FLTK.Widget_Callback_Conversions;
+
+
diff --git a/body/fltk-widget_callback_conversions.ads b/body/fltk-widget_callback_conversions.ads
new file mode 100644
index 0000000..09932b4
--- /dev/null
+++ b/body/fltk-widget_callback_conversions.ads
@@ -0,0 +1,26 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+limited with
+
+ FLTK.Widgets;
+
+
+private package FLTK.Widget_Callback_Conversions is
+
+
+ function To_Access
+ (Addy : in Storage.Integer_Address)
+ return FLTK.Widgets.Widget_Callback;
+
+ function To_Address
+ (Call : in FLTK.Widgets.Widget_Callback)
+ return Storage.Integer_Address;
+
+
+end FLTK.Widget_Callback_Conversions;
+
+
diff --git a/body/fltk-widgets-boxes.adb b/body/fltk-widgets-boxes.adb
new file mode 100644
index 0000000..e412131
--- /dev/null
+++ b/body/fltk-widgets-boxes.adb
@@ -0,0 +1,191 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Boxes is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_box
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_box, "new_fl_box");
+ pragma Inline (new_fl_box);
+
+ function new_fl_box2
+ (K, X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_box2, "new_fl_box2");
+ pragma Inline (new_fl_box2);
+
+ procedure free_fl_box
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_box, "free_fl_box");
+ pragma Inline (free_fl_box);
+
+
+
+
+ procedure fl_box_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_box_draw, "fl_box_draw");
+ pragma Inline (fl_box_draw);
+
+ function fl_box_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_box_handle, "fl_box_handle");
+ pragma Inline (fl_box_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Box) is
+ begin
+ Extra_Final (Widget (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Box) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_box (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Box;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Widget (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Box) is
+ begin
+ This.Draw_Ptr := fl_box_draw'Address;
+ This.Handle_Ptr := fl_box_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Box is
+ begin
+ return This : Box := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+
+ function Create
+ (Kind : in Box_Kind;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Box is
+ begin
+ return This : Box do
+ This.Void_Ptr := new_fl_box2
+ (Box_Kind'Pos (Kind),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ Kind : in Box_Kind;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Box is
+ begin
+ return This : Box := Create (Kind, X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Draw
+ (This : in out Box) is
+ begin
+ Widget (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Box;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Widget (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Boxes;
+
+
diff --git a/body/fltk-widgets-buttons-enter.adb b/body/fltk-widgets-buttons-enter.adb
new file mode 100644
index 0000000..3a9e026
--- /dev/null
+++ b/body/fltk-widgets-buttons-enter.adb
@@ -0,0 +1,152 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Buttons.Enter is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_return_button
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_return_button, "new_fl_return_button");
+ pragma Inline (new_fl_return_button);
+
+ procedure free_fl_return_button
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_return_button, "free_fl_return_button");
+ pragma Inline (free_fl_return_button);
+
+
+
+
+ procedure fl_return_button_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_return_button_draw, "fl_return_button_draw");
+ pragma Inline (fl_return_button_draw);
+
+ function fl_return_button_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_return_button_handle, "fl_return_button_handle");
+ pragma Inline (fl_return_button_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Enter_Button) is
+ begin
+ Extra_Final (Button (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Enter_Button) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_return_button (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Enter_Button;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Button (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Enter_Button) is
+ begin
+ This.Draw_Ptr := fl_return_button_draw'Address;
+ This.Handle_Ptr := fl_return_button_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Enter_Button is
+ begin
+ return This : Enter_Button := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Draw
+ (This : in out Enter_Button) is
+ begin
+ Button (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Enter_Button;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Button (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Buttons.Enter;
+
+
diff --git a/body/fltk-widgets-buttons-light-check.adb b/body/fltk-widgets-buttons-light-check.adb
new file mode 100644
index 0000000..de35223
--- /dev/null
+++ b/body/fltk-widgets-buttons-light-check.adb
@@ -0,0 +1,170 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Buttons.Light.Check is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_check_button
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_check_button, "new_fl_check_button");
+ pragma Inline (new_fl_check_button);
+
+ procedure free_fl_check_button
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_check_button, "free_fl_check_button");
+ pragma Inline (free_fl_check_button);
+
+
+
+
+ procedure fl_check_button_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_check_button_draw, "fl_check_button_draw");
+ pragma Inline (fl_check_button_draw);
+
+ function fl_check_button_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_button_handle, "fl_check_button_handle");
+ pragma Inline (fl_check_button_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ -- Round the world and home again, that's the sailor's way!
+ procedure check_button_extra_final_hook
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Export (C, check_button_extra_final_hook, "check_button_extra_final_hook");
+
+ procedure check_button_extra_final_hook
+ (Ada_Obj : in Storage.Integer_Address)
+ is
+ My_Check_Button : Check_Button;
+ for My_Check_Button'Address use Storage.To_Address (Ada_Obj);
+ pragma Import (Ada, My_Check_Button);
+ begin
+ Extra_Final (My_Check_Button);
+ end check_button_extra_final_hook;
+
+
+ procedure Extra_Final
+ (This : in out Check_Button) is
+ begin
+ Extra_Final (Light_Button (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Check_Button) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_check_button (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ -- Arrived at the flip side
+ procedure check_button_extra_init_hook
+ (Ada_Obj : Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.Strings.chars_ptr);
+ pragma Export (C, check_button_extra_init_hook, "check_button_extra_init_hook");
+
+ procedure check_button_extra_init_hook
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.Strings.chars_ptr)
+ is
+ My_Check_Button : Check_Button;
+ for My_Check_Button'Address use Storage.To_Address (Ada_Obj);
+ pragma Import (Ada, My_Check_Button);
+ begin
+ Extra_Init
+ (My_Check_Button,
+ Integer (X), Integer (Y),
+ Integer (W), Integer (H),
+ Interfaces.C.Strings.Value (C_Str));
+ end check_button_extra_init_hook;
+
+
+ procedure Extra_Init
+ (This : in out Check_Button;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Light_Button (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Check_Button) is
+ begin
+ This.Draw_Ptr := fl_check_button_draw'Address;
+ This.Handle_Ptr := fl_check_button_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Check_Button is
+ begin
+ return This : Check_Button := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Buttons.Light.Check;
+
+
diff --git a/body/fltk-widgets-buttons-light-radio.adb b/body/fltk-widgets-buttons-light-radio.adb
new file mode 100644
index 0000000..9aef7bd
--- /dev/null
+++ b/body/fltk-widgets-buttons-light-radio.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Buttons.Light.Radio is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_radio_light_button
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_radio_light_button, "new_fl_radio_light_button");
+ pragma Inline (new_fl_radio_light_button);
+
+ procedure free_fl_radio_light_button
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_radio_light_button, "free_fl_radio_light_button");
+ pragma Inline (free_fl_radio_light_button);
+
+
+
+
+ procedure fl_radio_light_button_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_radio_light_button_draw, "fl_radio_light_button_draw");
+ pragma Inline (fl_radio_light_button_draw);
+
+ function fl_radio_light_button_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_radio_light_button_handle, "fl_radio_light_button_handle");
+ pragma Inline (fl_radio_light_button_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Radio_Light_Button) is
+ begin
+ Extra_Final (Light_Button (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Radio_Light_Button) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_radio_light_button (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Radio_Light_Button;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Light_Button (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Radio_Light_Button) is
+ begin
+ This.Draw_Ptr := fl_radio_light_button_draw'Address;
+ This.Handle_Ptr := fl_radio_light_button_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Radio_Light_Button is
+ begin
+ return This : Radio_Light_Button := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Buttons.Light.Radio;
+
+
diff --git a/body/fltk-widgets-buttons-light-round-radio.adb b/body/fltk-widgets-buttons-light-round-radio.adb
new file mode 100644
index 0000000..b277922
--- /dev/null
+++ b/body/fltk-widgets-buttons-light-round-radio.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Buttons.Light.Round.Radio is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_radio_round_button
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_radio_round_button, "new_fl_radio_round_button");
+ pragma Inline (new_fl_radio_round_button);
+
+ procedure free_fl_radio_round_button
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_radio_round_button, "free_fl_radio_round_button");
+ pragma Inline (free_fl_radio_round_button);
+
+
+
+
+ procedure fl_radio_round_button_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_radio_round_button_draw, "fl_radio_round_button_draw");
+ pragma Inline (fl_radio_round_button_draw);
+
+ function fl_radio_round_button_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_radio_round_button_handle, "fl_radio_round_button_handle");
+ pragma Inline (fl_radio_round_button_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Radio_Round_Button) is
+ begin
+ Extra_Final (Round_Button (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Radio_Round_Button) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_radio_round_button (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Radio_Round_Button;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Round_Button (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Radio_Round_Button) is
+ begin
+ This.Draw_Ptr := fl_radio_round_button_draw'Address;
+ This.Handle_Ptr := fl_radio_round_button_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Radio_Round_Button is
+ begin
+ return This : Radio_Round_Button := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Buttons.Light.Round.Radio;
+
+
diff --git a/body/fltk-widgets-buttons-light-round.adb b/body/fltk-widgets-buttons-light-round.adb
new file mode 100644
index 0000000..172c112
--- /dev/null
+++ b/body/fltk-widgets-buttons-light-round.adb
@@ -0,0 +1,129 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Buttons.Light.Round is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_round_button
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_round_button, "new_fl_round_button");
+ pragma Inline (new_fl_round_button);
+
+ procedure free_fl_round_button
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_round_button, "free_fl_round_button");
+ pragma Inline (free_fl_round_button);
+
+
+
+
+ procedure fl_round_button_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_round_button_draw, "fl_round_button_draw");
+ pragma Inline (fl_round_button_draw);
+
+ function fl_round_button_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_round_button_handle, "fl_round_button_handle");
+ pragma Inline (fl_round_button_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Round_Button) is
+ begin
+ Extra_Final (Light_Button (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Round_Button) is
+ begin
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_round_button (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Round_Button;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Light_Button (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Round_Button) is
+ begin
+ This.Draw_Ptr := fl_round_button_draw'Address;
+ This.Handle_Ptr := fl_round_button_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Round_Button is
+ begin
+ return This : Round_Button := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Buttons.Light.Round;
+
+
diff --git a/body/fltk-widgets-buttons-light.adb b/body/fltk-widgets-buttons-light.adb
new file mode 100644
index 0000000..3e4791a
--- /dev/null
+++ b/body/fltk-widgets-buttons-light.adb
@@ -0,0 +1,152 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Buttons.Light is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_light_button
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_light_button, "new_fl_light_button");
+ pragma Inline (new_fl_light_button);
+
+ procedure free_fl_light_button
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_light_button, "free_fl_light_button");
+ pragma Inline (free_fl_light_button);
+
+
+
+
+ procedure fl_light_button_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_light_button_draw, "fl_light_button_draw");
+ pragma Inline (fl_light_button_draw);
+
+ function fl_light_button_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_light_button_handle, "fl_light_button_handle");
+ pragma Inline (fl_light_button_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Light_Button) is
+ begin
+ Extra_Final (Button (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Light_Button) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_light_button (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Light_Button;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Button (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Light_Button) is
+ begin
+ This.Draw_Ptr := fl_light_button_draw'Address;
+ This.Handle_Ptr := fl_light_button_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Light_Button is
+ begin
+ return This : Light_Button := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Draw
+ (This : in out Light_Button) is
+ begin
+ Button (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Light_Button;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Button (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Buttons.Light;
+
+
diff --git a/body/fltk-widgets-buttons-radio.adb b/body/fltk-widgets-buttons-radio.adb
new file mode 100644
index 0000000..b51af60
--- /dev/null
+++ b/body/fltk-widgets-buttons-radio.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Buttons.Radio is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_radio_button
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_radio_button, "new_fl_radio_button");
+ pragma Inline (new_fl_radio_button);
+
+ procedure free_fl_radio_button
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_radio_button, "free_fl_radio_button");
+ pragma Inline (free_fl_radio_button);
+
+
+
+
+ procedure fl_radio_button_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_radio_button_draw, "fl_radio_button_draw");
+ pragma Inline (fl_radio_button_draw);
+
+ function fl_radio_button_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_radio_button_handle, "fl_radio_button_handle");
+ pragma Inline (fl_radio_button_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Radio_Button) is
+ begin
+ Extra_Final (Button (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Radio_Button) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_radio_button (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Radio_Button;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Button (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Radio_Button) is
+ begin
+ This.Draw_Ptr := fl_radio_button_draw'Address;
+ This.Handle_Ptr := fl_radio_button_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Radio_Button is
+ begin
+ return This : Radio_Button := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Buttons.Radio;
+
+
diff --git a/body/fltk-widgets-buttons-repeat.adb b/body/fltk-widgets-buttons-repeat.adb
new file mode 100644
index 0000000..eda24fd
--- /dev/null
+++ b/body/fltk-widgets-buttons-repeat.adb
@@ -0,0 +1,162 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Buttons.Repeat is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_repeat_button
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_repeat_button, "new_fl_repeat_button");
+ pragma Inline (new_fl_repeat_button);
+
+ procedure free_fl_repeat_button
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_repeat_button, "free_fl_repeat_button");
+ pragma Inline (free_fl_repeat_button);
+
+
+
+
+ procedure fl_repeat_button_deactivate
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_repeat_button_deactivate, "fl_repeat_button_deactivate");
+ pragma Inline (fl_repeat_button_deactivate);
+
+
+
+
+ procedure fl_repeat_button_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_repeat_button_draw, "fl_repeat_button_draw");
+ pragma Inline (fl_repeat_button_draw);
+
+ function fl_repeat_button_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_repeat_button_handle, "fl_repeat_button_handle");
+ pragma Inline (fl_repeat_button_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Repeat_Button) is
+ begin
+ Extra_Final (Button (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Repeat_Button) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_repeat_button (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Repeat_Button;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Button (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Repeat_Button) is
+ begin
+ This.Draw_Ptr := fl_repeat_button_draw'Address;
+ This.Handle_Ptr := fl_repeat_button_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Repeat_Button is
+ begin
+ return This : Repeat_Button := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Deactivate
+ (This : in out Repeat_Button) is
+ begin
+ fl_repeat_button_deactivate (This.Void_Ptr);
+ end Deactivate;
+
+
+
+
+ function Handle
+ (This : in out Repeat_Button;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Button (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Buttons.Repeat;
+
+
diff --git a/body/fltk-widgets-buttons-toggle.adb b/body/fltk-widgets-buttons-toggle.adb
new file mode 100644
index 0000000..a93fa36
--- /dev/null
+++ b/body/fltk-widgets-buttons-toggle.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Buttons.Toggle is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_toggle_button
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_toggle_button, "new_fl_toggle_button");
+ pragma Inline (new_fl_toggle_button);
+
+ procedure free_fl_toggle_button
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_toggle_button, "free_fl_toggle_button");
+ pragma Inline (free_fl_toggle_button);
+
+
+
+
+ procedure fl_toggle_button_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_toggle_button_draw, "fl_toggle_button_draw");
+ pragma Inline (fl_toggle_button_draw);
+
+ function fl_toggle_button_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_toggle_button_handle, "fl_toggle_button_handle");
+ pragma Inline (fl_toggle_button_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Toggle_Button) is
+ begin
+ Extra_Final (Button (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Toggle_Button) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_toggle_button (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Toggle_Button;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Button (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Toggle_Button) is
+ begin
+ This.Draw_Ptr := fl_toggle_button_draw'Address;
+ This.Handle_Ptr := fl_toggle_button_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Toggle_Button is
+ begin
+ return This : Toggle_Button := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Buttons.Toggle;
+
+
diff --git a/body/fltk-widgets-buttons.adb b/body/fltk-widgets-buttons.adb
new file mode 100644
index 0000000..1e7ef60
--- /dev/null
+++ b/body/fltk-widgets-buttons.adb
@@ -0,0 +1,323 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Buttons is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_button
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_button, "new_fl_button");
+ pragma Inline (new_fl_button);
+
+ procedure free_fl_button
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_button, "free_fl_button");
+ pragma Inline (free_fl_button);
+
+
+
+
+ function fl_button_get_state
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_button_get_state, "fl_button_get_state");
+ pragma Inline (fl_button_get_state);
+
+ procedure fl_button_set_state
+ (B : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_button_set_state, "fl_button_set_state");
+ pragma Inline (fl_button_set_state);
+
+ procedure fl_button_set_only
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_button_set_only, "fl_button_set_only");
+ pragma Inline (fl_button_set_only);
+
+
+
+
+ function fl_button_get_down_box
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_button_get_down_box, "fl_button_get_down_box");
+ pragma Inline (fl_button_get_down_box);
+
+ procedure fl_button_set_down_box
+ (B : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_button_set_down_box, "fl_button_set_down_box");
+ pragma Inline (fl_button_set_down_box);
+
+ function fl_button_get_shortcut
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_button_get_shortcut, "fl_button_get_shortcut");
+ pragma Inline (fl_button_get_shortcut);
+
+ procedure fl_button_set_shortcut
+ (B : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_button_set_shortcut, "fl_button_set_shortcut");
+ pragma Inline (fl_button_set_shortcut);
+
+
+
+
+ procedure fl_button_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_button_draw, "fl_button_draw");
+ pragma Inline (fl_button_draw);
+
+ function fl_button_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_button_handle, "fl_button_handle");
+ pragma Inline (fl_button_handle);
+
+
+
+
+ procedure fl_button_simulate_key_action
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_button_simulate_key_action, "fl_button_simulate_key_action");
+ pragma Inline (fl_button_simulate_key_action);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ -- Clipper route successfully navigated
+ procedure button_extra_final_hook
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Export (C, button_extra_final_hook, "button_extra_final_hook");
+
+ procedure button_extra_final_hook
+ (Ada_Obj : in Storage.Integer_Address)
+ is
+ My_Button : Button;
+ for My_Button'Address use Storage.To_Address (Ada_Obj);
+ pragma Import (Ada, My_Button);
+ begin
+ Extra_Final (My_Button);
+ end button_extra_final_hook;
+
+
+ procedure Extra_Final
+ (This : in out Button) is
+ begin
+ Extra_Final (Widget (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Button) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_button (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ -- Mobius strip traversal complete
+ procedure button_extra_init_hook
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.Strings.chars_ptr);
+ pragma Export (C, button_extra_init_hook, "button_extra_init_hook");
+
+ procedure button_extra_init_hook
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.Strings.chars_ptr)
+ is
+ My_Button : Button;
+ for My_Button'Address use Storage.To_Address (Ada_Obj);
+ pragma Import (Ada, My_Button);
+ begin
+ Extra_Init
+ (My_Button,
+ Integer (X), Integer (Y),
+ Integer (W), Integer (H),
+ Interfaces.C.Strings.Value (C_Str));
+ end button_extra_init_hook;
+
+
+ procedure Extra_Init
+ (This : in out Button;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Widget (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Button) is
+ begin
+ This.Draw_Ptr := fl_button_draw'Address;
+ This.Handle_Ptr := fl_button_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Button is
+ begin
+ return This : Button := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Is_On
+ (This : in Button)
+ return Boolean is
+ begin
+ return This.Get_State = On;
+ end Is_On;
+
+
+ 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;
+
+
+
+
+ function Get_Down_Box
+ (This : in Button)
+ return Box_Kind is
+ begin
+ return Box_Kind'Val (fl_button_get_down_box (This.Void_Ptr));
+ end Get_Down_Box;
+
+
+ procedure Set_Down_Box
+ (This : in out Button;
+ To : in Box_Kind) is
+ begin
+ fl_button_set_down_box (This.Void_Ptr, Box_Kind'Pos (To));
+ end Set_Down_Box;
+
+
+ function Get_Shortcut
+ (This : in Button)
+ return Key_Combo is
+ begin
+ return To_Ada (fl_button_get_shortcut (This.Void_Ptr));
+ end Get_Shortcut;
+
+
+ procedure Set_Shortcut
+ (This : in out Button;
+ Key : in Key_Combo) is
+ begin
+ fl_button_set_shortcut (This.Void_Ptr, Interfaces.C.int (To_C (Key)));
+ end Set_Shortcut;
+
+
+
+
+ procedure Draw
+ (This : in out Button) is
+ begin
+ Widget (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Button;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Widget (This).Handle (Event);
+ end Handle;
+
+
+
+
+ procedure Simulate_Key_Action
+ (This : in out Button) is
+ begin
+ fl_button_simulate_key_action (This.Void_Ptr);
+ end Simulate_Key_Action;
+
+
+end FLTK.Widgets.Buttons;
+
+
diff --git a/body/fltk-widgets-charts.adb b/body/fltk-widgets-charts.adb
new file mode 100644
index 0000000..2d4615d
--- /dev/null
+++ b/body/fltk-widgets-charts.adb
@@ -0,0 +1,453 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Charts is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_chart
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_chart, "new_fl_chart");
+ pragma Inline (new_fl_chart);
+
+ procedure free_fl_chart
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_chart, "free_fl_chart");
+ pragma Inline (free_fl_chart);
+
+
+
+
+ procedure fl_chart_add
+ (C : in Storage.Integer_Address;
+ V : in Interfaces.C.double;
+ L : in Interfaces.C.char_array;
+ P : in Interfaces.C.unsigned);
+ pragma Import (C, fl_chart_add, "fl_chart_add");
+ pragma Inline (fl_chart_add);
+
+ procedure fl_chart_insert
+ (C : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ V : in Interfaces.C.double;
+ L : in Interfaces.C.char_array;
+ P : in Interfaces.C.unsigned);
+ pragma Import (C, fl_chart_insert, "fl_chart_insert");
+ pragma Inline (fl_chart_insert);
+
+ procedure fl_chart_replace
+ (C : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ V : in Interfaces.C.double;
+ L : in Interfaces.C.char_array;
+ P : in Interfaces.C.unsigned);
+ pragma Import (C, fl_chart_replace, "fl_chart_replace");
+ pragma Inline (fl_chart_replace);
+
+ procedure fl_chart_clear
+ (C : in Storage.Integer_Address);
+ pragma Import (C, fl_chart_clear, "fl_chart_clear");
+ pragma Inline (fl_chart_clear);
+
+
+
+
+ function fl_chart_get_autosize
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_chart_get_autosize, "fl_chart_get_autosize");
+ pragma Inline (fl_chart_get_autosize);
+
+ procedure fl_chart_set_autosize
+ (C : in Storage.Integer_Address;
+ A : in Interfaces.C.int);
+ pragma Import (C, fl_chart_set_autosize, "fl_chart_set_autosize");
+ pragma Inline (fl_chart_set_autosize);
+
+ procedure fl_chart_get_bounds
+ (C : in Storage.Integer_Address;
+ L, U : out Interfaces.C.double);
+ pragma Import (C, fl_chart_get_bounds, "fl_chart_get_bounds");
+ pragma Inline (fl_chart_get_bounds);
+
+ procedure fl_chart_set_bounds
+ (C : in Storage.Integer_Address;
+ L, U : in Interfaces.C.double);
+ pragma Import (C, fl_chart_set_bounds, "fl_chart_set_bounds");
+ pragma Inline (fl_chart_set_bounds);
+
+ function fl_chart_get_maxsize
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_chart_get_maxsize, "fl_chart_get_maxsize");
+ pragma Inline (fl_chart_get_maxsize);
+
+ procedure fl_chart_set_maxsize
+ (C : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_chart_set_maxsize, "fl_chart_set_maxsize");
+ pragma Inline (fl_chart_set_maxsize);
+
+ function fl_chart_size
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_chart_size, "fl_chart_size");
+ pragma Inline (fl_chart_size);
+
+
+
+
+ function fl_chart_get_textcolor
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_chart_get_textcolor, "fl_chart_get_textcolor");
+ pragma Inline (fl_chart_get_textcolor);
+
+ procedure fl_chart_set_textcolor
+ (C : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned);
+ pragma Import (C, fl_chart_set_textcolor, "fl_chart_set_textcolor");
+ pragma Inline (fl_chart_set_textcolor);
+
+ function fl_chart_get_textfont
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_chart_get_textfont, "fl_chart_get_textfont");
+ pragma Inline (fl_chart_get_textfont);
+
+ procedure fl_chart_set_textfont
+ (C : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_chart_set_textfont, "fl_chart_set_textfont");
+ pragma Inline (fl_chart_set_textfont);
+
+ function fl_chart_get_textsize
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_chart_get_textsize, "fl_chart_get_textsize");
+ pragma Inline (fl_chart_get_textsize);
+
+ procedure fl_chart_set_textsize
+ (C : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_chart_set_textsize, "fl_chart_set_textsize");
+ pragma Inline (fl_chart_set_textsize);
+
+
+
+
+ procedure fl_chart_size2
+ (C : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int);
+ pragma Import (C, fl_chart_size2, "fl_chart_size2");
+ pragma Inline (fl_chart_size2);
+
+
+
+
+ procedure fl_chart_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_chart_draw, "fl_chart_draw");
+ pragma Inline (fl_chart_draw);
+
+ function fl_chart_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_chart_handle, "fl_chart_handle");
+ pragma Inline (fl_chart_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Chart) is
+ begin
+ Extra_Final (Widget (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Chart) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_chart (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Chart;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Widget (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Chart) is
+ begin
+ This.Draw_Ptr := fl_chart_draw'Address;
+ This.Handle_Ptr := fl_chart_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Chart is
+ begin
+ return This : Chart do
+ This.Void_Ptr := new_fl_chart
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Chart is
+ begin
+ return This : Chart := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Add
+ (This : in out Chart;
+ Data_Value : in Long_Float;
+ Data_Label : in String := "";
+ Data_Color : in Color := Foreground_Color) is
+ begin
+ fl_chart_add
+ (This.Void_Ptr,
+ Interfaces.C.double (Data_Value),
+ Interfaces.C.To_C (Data_Label),
+ Interfaces.C.unsigned (Data_Color));
+ end Add;
+
+
+ procedure Insert
+ (This : in out Chart;
+ Position : in Natural;
+ Data_Value : in Long_Float;
+ Data_Label : in String := "";
+ Data_Color : in Color := Foreground_Color) is
+ begin
+ fl_chart_insert
+ (This.Void_Ptr,
+ Interfaces.C.int (Position),
+ Interfaces.C.double (Data_Value),
+ Interfaces.C.To_C (Data_Label),
+ Interfaces.C.unsigned (Data_Color));
+ end Insert;
+
+
+ procedure Replace
+ (This : in out Chart;
+ Position : in Natural;
+ Data_Value : in Long_Float;
+ Data_Label : in String := "";
+ Data_Color : in Color := Foreground_Color) is
+ begin
+ fl_chart_replace
+ (This.Void_Ptr,
+ Interfaces.C.int (Position),
+ Interfaces.C.double (Data_Value),
+ Interfaces.C.To_C (Data_Label),
+ Interfaces.C.unsigned (Data_Color));
+ end Replace;
+
+
+ procedure Clear
+ (This : in out Chart) is
+ begin
+ fl_chart_clear (This.Void_Ptr);
+ end Clear;
+
+
+
+
+ function Will_Autosize
+ (This : in Chart)
+ return Boolean is
+ begin
+ return fl_chart_get_autosize (This.Void_Ptr) /= 0;
+ end Will_Autosize;
+
+
+ procedure Set_Autosize
+ (This : in out Chart;
+ To : in Boolean) is
+ begin
+ fl_chart_set_autosize (This.Void_Ptr, Boolean'Pos (To));
+ end Set_Autosize;
+
+
+ procedure Get_Bounds
+ (This : in Chart;
+ Lower, Upper : out Long_Float) is
+ begin
+ fl_chart_get_bounds
+ (This.Void_Ptr,
+ Interfaces.C.double (Lower),
+ Interfaces.C.double (Upper));
+ end Get_Bounds;
+
+
+ procedure Set_Bounds
+ (This : in out Chart;
+ Lower, Upper : in Long_Float) is
+ begin
+ fl_chart_set_bounds
+ (This.Void_Ptr,
+ Interfaces.C.double (Lower),
+ Interfaces.C.double (Upper));
+ end Set_Bounds;
+
+
+ function Get_Maximum_Size
+ (This : in Chart)
+ return Natural is
+ begin
+ return Natural (fl_chart_get_maxsize (This.Void_Ptr));
+ end Get_Maximum_Size;
+
+
+ procedure Set_Maximum_Size
+ (This : in out Chart;
+ To : in Natural) is
+ begin
+ fl_chart_set_maxsize (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Maximum_Size;
+
+
+ function Get_Size
+ (This : in Chart)
+ return Natural is
+ begin
+ return Natural (fl_chart_size (This.Void_Ptr));
+ end Get_Size;
+
+
+
+
+ function Get_Text_Color
+ (This : in Chart)
+ return Color is
+ begin
+ return Color (fl_chart_get_textcolor (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Chart;
+ To : in Color) is
+ begin
+ fl_chart_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Chart)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_chart_get_textfont (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Chart;
+ To : in Font_Kind) is
+ begin
+ fl_chart_set_textfont (This.Void_Ptr, Font_Kind'Pos (To));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Chart)
+ return Font_Size is
+ begin
+ return Font_Size (fl_chart_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Chart;
+ To : in Font_Size) is
+ begin
+ fl_chart_set_textsize (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Text_Size;
+
+
+
+
+ procedure Resize
+ (This : in out Chart;
+ W, H : in Integer) is
+ begin
+ fl_chart_size2 (This.Void_Ptr, Interfaces.C.int (W), Interfaces.C.int (H));
+ end Resize;
+
+
+
+
+ procedure Draw
+ (This : in out Chart) is
+ begin
+ Widget (This).Draw;
+ end Draw;
+
+
+end FLTK.Widgets.Charts;
+
+
diff --git a/body/fltk-widgets-clocks-updated-round.adb b/body/fltk-widgets-clocks-updated-round.adb
new file mode 100644
index 0000000..4f4487b
--- /dev/null
+++ b/body/fltk-widgets-clocks-updated-round.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Clocks.Updated.Round is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_round_clock
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_round_clock, "new_fl_round_clock");
+ pragma Inline (new_fl_round_clock);
+
+ procedure free_fl_round_clock
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_round_clock, "free_fl_round_clock");
+ pragma Inline (free_fl_round_clock);
+
+
+
+
+ procedure fl_round_clock_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_round_clock_draw, "fl_round_clock_draw");
+ pragma Inline (fl_round_clock_draw);
+
+ function fl_round_clock_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_round_clock_handle, "fl_round_clock_handle");
+ pragma Inline (fl_round_clock_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Round_Clock) is
+ begin
+ Extra_Final (Updated_Clock (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Round_Clock) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_round_clock (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Round_Clock;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Updated_Clock (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Round_Clock) is
+ begin
+ This.Draw_Ptr := fl_round_clock_draw'Address;
+ This.Handle_Ptr := fl_round_clock_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Round_Clock is
+ begin
+ return This : Round_Clock do
+ This.Void_Ptr := new_fl_round_clock
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Round_Clock is
+ begin
+ return This : Round_Clock := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Clocks.Updated.Round;
+
+
diff --git a/body/fltk-widgets-clocks-updated.adb b/body/fltk-widgets-clocks-updated.adb
new file mode 100644
index 0000000..8b7d5e6
--- /dev/null
+++ b/body/fltk-widgets-clocks-updated.adb
@@ -0,0 +1,185 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Clocks.Updated is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_clock
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_clock, "new_fl_clock");
+ pragma Inline (new_fl_clock);
+
+ function new_fl_clock2
+ (K : in Interfaces.C.unsigned_char;
+ X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_clock2, "new_fl_clock2");
+ pragma Inline (new_fl_clock2);
+
+ procedure free_fl_clock
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_clock, "free_fl_clock");
+ pragma Inline (free_fl_clock);
+
+
+
+
+ procedure fl_clock_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_clock_draw, "fl_clock_draw");
+ pragma Inline (fl_clock_draw);
+
+ function fl_clock_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_clock_handle, "fl_clock_handle");
+ pragma Inline (fl_clock_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Updated_Clock) is
+ begin
+ Extra_Final (Clock (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Updated_Clock) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_clock (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Updated_Clock;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Clock (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Updated_Clock) is
+ begin
+ This.Draw_Ptr := fl_clock_draw'Address;
+ This.Handle_Ptr := fl_clock_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Updated_Clock is
+ begin
+ return This : Updated_Clock do
+ This.Void_Ptr := new_fl_clock
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Updated_Clock is
+ begin
+ return This : Updated_Clock := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+
+ function Create
+ (Kind : in Box_Kind;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Updated_Clock is
+ begin
+ return This : Updated_Clock do
+ This.Void_Ptr := new_fl_clock2
+ (Box_Kind'Pos (Kind),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ Kind : in Box_Kind;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Updated_Clock is
+ begin
+ return This : Updated_Clock := Create (Kind, X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Handle
+ (This : in out Updated_Clock;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Clock (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Clocks.Updated;
+
+
diff --git a/body/fltk-widgets-clocks.adb b/body/fltk-widgets-clocks.adb
new file mode 100644
index 0000000..08be495
--- /dev/null
+++ b/body/fltk-widgets-clocks.adb
@@ -0,0 +1,262 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Clocks is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_clock_output
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_clock_output, "new_fl_clock_output");
+ pragma Inline (new_fl_clock_output);
+
+ procedure free_fl_clock_output
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_clock_output, "free_fl_clock_output");
+ pragma Inline (free_fl_clock_output);
+
+
+
+
+ function fl_clock_output_get_hour
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_clock_output_get_hour, "fl_clock_output_get_hour");
+ pragma Inline (fl_clock_output_get_hour);
+
+ function fl_clock_output_get_minute
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_clock_output_get_minute, "fl_clock_output_get_minute");
+ pragma Inline (fl_clock_output_get_minute);
+
+ function fl_clock_output_get_second
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_clock_output_get_second, "fl_clock_output_get_second");
+ pragma Inline (fl_clock_output_get_second);
+
+
+
+
+ function fl_clock_output_get_value
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.unsigned_long;
+ pragma Import (C, fl_clock_output_get_value, "fl_clock_output_get_value");
+ pragma Inline (fl_clock_output_get_value);
+
+ procedure fl_clock_output_set_value
+ (C : in Storage.Integer_Address;
+ V : in Interfaces.C.unsigned_long);
+ pragma Import (C, fl_clock_output_set_value, "fl_clock_output_set_value");
+ pragma Inline (fl_clock_output_set_value);
+
+ procedure fl_clock_output_set_value2
+ (C : in Storage.Integer_Address;
+ H, M, S : in Interfaces.C.int);
+ pragma Import (C, fl_clock_output_set_value2, "fl_clock_output_set_value2");
+ pragma Inline (fl_clock_output_set_value2);
+
+
+
+
+ procedure fl_clock_output_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_clock_output_draw, "fl_clock_output_draw");
+ pragma Inline (fl_clock_output_draw);
+
+ procedure fl_clock_output_draw2
+ (C : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_clock_output_draw2, "fl_clock_output_draw2");
+ pragma Inline (fl_clock_output_draw2);
+
+ function fl_clock_output_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_clock_output_handle, "fl_clock_output_handle");
+ pragma Inline (fl_clock_output_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Clock) is
+ begin
+ Extra_Final (Widget (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Clock) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_clock_output (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Clock;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Widget (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Clock) is
+ begin
+ This.Draw_Ptr := fl_clock_output_draw'Address;
+ This.Handle_Ptr := fl_clock_output_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Clock is
+ begin
+ return This : Clock do
+ This.Void_Ptr := new_fl_clock_output
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Clock is
+ begin
+ return This : Clock := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Hour
+ (This : in Clock)
+ return Hour is
+ begin
+ return Hour (fl_clock_output_get_hour (This.Void_Ptr));
+ end Get_Hour;
+
+
+ function Get_Minute
+ (This : in Clock)
+ return Minute is
+ begin
+ return Minute (fl_clock_output_get_minute (This.Void_Ptr));
+ end Get_Minute;
+
+
+ function Get_Second
+ (This : in Clock)
+ return Second is
+ begin
+ return Second (fl_clock_output_get_second (This.Void_Ptr));
+ end Get_Second;
+
+
+
+
+ function Get_Time
+ (This : in Clock)
+ return Time_Value is
+ begin
+ return Time_Value (fl_clock_output_get_value (This.Void_Ptr));
+ end Get_Time;
+
+
+ procedure Set_Time
+ (This : in out Clock;
+ To : in Time_Value) is
+ begin
+ fl_clock_output_set_value (This.Void_Ptr, Interfaces.C.unsigned_long (To));
+ end Set_Time;
+
+
+ procedure Set_Time
+ (This : in out Clock;
+ Hours : in Hour;
+ Minutes : in Minute;
+ Seconds : in Second) is
+ begin
+ fl_clock_output_set_value2
+ (This.Void_Ptr,
+ Interfaces.C.int (Hours),
+ Interfaces.C.int (Minutes),
+ Interfaces.C.int (Seconds));
+ end Set_Time;
+
+
+
+
+ procedure Draw
+ (This : in out Clock) is
+ begin
+ Widget (This).Draw;
+ end Draw;
+
+
+ procedure Draw
+ (This : in out Clock;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_clock_output_draw2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Draw;
+
+
+end FLTK.Widgets.Clocks;
+
+
diff --git a/body/fltk-widgets-groups-browsers-check.adb b/body/fltk-widgets-groups-browsers-check.adb
new file mode 100644
index 0000000..730dcd4
--- /dev/null
+++ b/body/fltk-widgets-groups-browsers-check.adb
@@ -0,0 +1,510 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Groups.Browsers.Check is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_check_browser
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_check_browser, "new_fl_check_browser");
+ pragma Inline (new_fl_check_browser);
+
+ procedure free_fl_check_browser
+ (C : in Storage.Integer_Address);
+ pragma Import (C, free_fl_check_browser, "free_fl_check_browser");
+ pragma Inline (free_fl_check_browser);
+
+
+
+
+ function fl_check_browser_add
+ (C : in Storage.Integer_Address;
+ S : in Interfaces.C.char_array;
+ B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_add, "fl_check_browser_add");
+ pragma Inline (fl_check_browser_add);
+
+ function fl_check_browser_remove
+ (C : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_remove, "fl_check_browser_remove");
+ pragma Inline (fl_check_browser_remove);
+
+ procedure fl_check_browser_clear
+ (C : in Storage.Integer_Address);
+ pragma Import (C, fl_check_browser_clear, "fl_check_browser_clear");
+ pragma Inline (fl_check_browser_clear);
+
+ function fl_check_browser_nitems
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_nitems, "fl_check_browser_nitems");
+ pragma Inline (fl_check_browser_nitems);
+
+
+
+
+ procedure fl_check_browser_check_all
+ (C : in Storage.Integer_Address);
+ pragma Import (C, fl_check_browser_check_all, "fl_check_browser_check_all");
+ pragma Inline (fl_check_browser_check_all);
+
+ procedure fl_check_browser_check_none
+ (C : in Storage.Integer_Address);
+ pragma Import (C, fl_check_browser_check_none, "fl_check_browser_check_none");
+ pragma Inline (fl_check_browser_check_none);
+
+ function fl_check_browser_get_checked
+ (C : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_get_checked, "fl_check_browser_get_checked");
+ pragma Inline (fl_check_browser_get_checked);
+
+ procedure fl_check_browser_set_checked
+ (C : in Storage.Integer_Address;
+ I, B : in Interfaces.C.int);
+ pragma Import (C, fl_check_browser_set_checked, "fl_check_browser_set_checked");
+ pragma Inline (fl_check_browser_set_checked);
+
+ function fl_check_browser_nchecked
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_nchecked, "fl_check_browser_nchecked");
+ pragma Inline (fl_check_browser_nchecked);
+
+
+
+
+ function fl_check_browser_text
+ (C : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_check_browser_text, "fl_check_browser_text");
+ pragma Inline (fl_check_browser_text);
+
+ function fl_check_browser_value
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_value, "fl_check_browser_value");
+ pragma Inline (fl_check_browser_value);
+
+
+
+
+ function fl_check_browser_full_width
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_full_width, "fl_check_browser_full_width");
+ pragma Inline (fl_check_browser_full_width);
+
+ function fl_check_browser_full_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_full_height, "fl_check_browser_full_height");
+ pragma Inline (fl_check_browser_full_height);
+
+ function fl_check_browser_incr_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_incr_height, "fl_check_browser_incr_height");
+ pragma Inline (fl_check_browser_incr_height);
+
+ function fl_check_browser_item_quick_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_item_quick_height, "fl_check_browser_item_quick_height");
+ pragma Inline (fl_check_browser_item_quick_height);
+
+
+
+
+ function fl_check_browser_item_width
+ (C, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_item_width, "fl_check_browser_item_width");
+ pragma Inline (fl_check_browser_item_width);
+
+ function fl_check_browser_item_height
+ (C, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_item_height, "fl_check_browser_item_height");
+ pragma Inline (fl_check_browser_item_height);
+
+ function fl_check_browser_item_first
+ (C : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_check_browser_item_first, "fl_check_browser_item_first");
+ pragma Inline (fl_check_browser_item_first);
+
+ -- Missing item_last
+
+ function fl_check_browser_item_next
+ (C, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_check_browser_item_next, "fl_check_browser_item_next");
+ pragma Inline (fl_check_browser_item_next);
+
+ function fl_check_browser_item_prev
+ (C, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_check_browser_item_prev, "fl_check_browser_item_prev");
+ pragma Inline (fl_check_browser_item_prev);
+
+ -- Missing item_at
+
+ procedure fl_check_browser_item_select
+ (C, I : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_check_browser_item_select, "fl_check_browser_item_select");
+ pragma Inline (fl_check_browser_item_select);
+
+ function fl_check_browser_item_selected
+ (C, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_item_selected, "fl_check_browser_item_selected");
+ pragma Inline (fl_check_browser_item_selected);
+
+ -- Missing item_swap and item_text
+
+ procedure fl_check_browser_item_draw
+ (C, I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_check_browser_item_draw, "fl_check_browser_item_draw");
+ pragma Inline (fl_check_browser_item_draw);
+
+
+
+
+ procedure fl_check_browser_draw
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_check_browser_draw, "fl_check_browser_draw");
+ pragma Inline (fl_check_browser_draw);
+
+ function fl_check_browser_handle
+ (B : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_check_browser_handle, "fl_check_browser_handle");
+ pragma Inline (fl_check_browser_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Check_Browser) is
+ begin
+ Extra_Final (Browser (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Check_Browser) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_check_browser (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Check_Browser;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Browser (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Check_Browser) is
+ begin
+ This.Wide_High_Ptrs :=
+ (Full_List_Width_Ptr => fl_check_browser_full_width'Address,
+ Full_List_Height_Ptr => fl_check_browser_full_height'Address,
+ Average_Item_Height_Ptr => fl_check_browser_incr_height'Address,
+ Item_Quick_Height_Ptr => fl_check_browser_item_quick_height'Address);
+ This.Draw_Ptr := fl_check_browser_draw'Address;
+ This.Handle_Ptr := fl_check_browser_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Check_Browser is
+ begin
+ return This : Check_Browser do
+ This.Void_Ptr := new_fl_check_browser
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Check_Browser is
+ begin
+ return This : Check_Browser := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -------------------------
+ -- Check_Browser API --
+ -------------------------
+
+ procedure Add
+ (This : in out Check_Browser;
+ Text : in String;
+ Checked : in Boolean := False)
+ is
+ Code : Interfaces.C.int := fl_check_browser_add
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ Boolean'Pos (Checked));
+ begin
+ null;
+ end Add;
+
+
+ procedure Remove
+ (This : in out Check_Browser;
+ Index : in Positive)
+ is
+ Code : Interfaces.C.int := fl_check_browser_remove
+ (This.Void_Ptr,
+ Interfaces.C.int (Index));
+ begin
+ null;
+ end Remove;
+
+
+ procedure Clear
+ (This : in out Check_Browser) is
+ begin
+ fl_check_browser_clear (This.Void_Ptr);
+ end Clear;
+
+
+ function Number_Of_Items
+ (This : in Check_Browser)
+ return Natural is
+ begin
+ return Natural (fl_check_browser_nitems (This.Void_Ptr));
+ end Number_Of_Items;
+
+
+
+
+ procedure Check_All
+ (This : in out Check_Browser) is
+ begin
+ fl_check_browser_check_all (This.Void_Ptr);
+ end Check_All;
+
+
+ procedure Check_None
+ (This : in out Check_Browser) is
+ begin
+ fl_check_browser_check_none (This.Void_Ptr);
+ end Check_None;
+
+
+ function Is_Checked
+ (This : in Check_Browser;
+ Index : in Positive)
+ return Boolean is
+ begin
+ return fl_check_browser_get_checked (This.Void_Ptr, Interfaces.C.int (Index)) /= 0;
+ end Is_Checked;
+
+
+ procedure Set_Checked
+ (This : in out Check_Browser;
+ Index : in Positive;
+ State : in Boolean := True) is
+ begin
+ fl_check_browser_set_checked
+ (This.Void_Ptr,
+ Interfaces.C.int (Index),
+ Boolean'Pos (State));
+ end Set_Checked;
+
+
+ function Number_Checked
+ (This : in Check_Browser)
+ return Natural is
+ begin
+ return Natural (fl_check_browser_nchecked (This.Void_Ptr));
+ end Number_Checked;
+
+
+
+
+ function Item_Text
+ (This : in Check_Browser;
+ Index : in Positive)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value
+ (fl_check_browser_text (This.Void_Ptr, Interfaces.C.int (Index)));
+ end Item_Text;
+
+
+ function Selected_Index
+ (This : in Check_Browser)
+ return Positive is
+ begin
+ return Positive (fl_check_browser_value (This.Void_Ptr));
+ end Selected_Index;
+
+
+
+
+ function Item_Width
+ (This : in Check_Browser;
+ Item : in Item_Cursor)
+ return Integer is
+ begin
+ return Integer (fl_check_browser_item_width
+ (This.Void_Ptr,
+ Cursor_To_Address (Item)));
+ end Item_Width;
+
+
+ function Item_Height
+ (This : in Check_Browser;
+ Item : in Item_Cursor)
+ return Integer is
+ begin
+ return Integer (fl_check_browser_item_height
+ (This.Void_Ptr,
+ Cursor_To_Address (Item)));
+ end Item_Height;
+
+
+ function Item_First
+ (This : in Check_Browser)
+ return Item_Cursor is
+ begin
+ return Address_To_Cursor (fl_check_browser_item_first (This.Void_Ptr));
+ end Item_First;
+
+
+ -- Note that Item_Last is not implemented
+
+
+ function Item_Next
+ (This : in Check_Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor is
+ begin
+ return Address_To_Cursor (fl_check_browser_item_next
+ (This.Void_Ptr,
+ Cursor_To_Address (Item)));
+ end Item_Next;
+
+
+ function Item_Previous
+ (This : in Check_Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor is
+ begin
+ return Address_To_Cursor (fl_check_browser_item_prev
+ (This.Void_Ptr,
+ Cursor_To_Address (Item)));
+ end Item_Previous;
+
+
+ -- Note that Item_At is not implemented
+
+
+ procedure Item_Select
+ (This : in out Check_Browser;
+ Item : in Item_Cursor;
+ State : in Boolean := True) is
+ begin
+ fl_check_browser_item_select
+ (This.Void_Ptr,
+ Cursor_To_Address (Item),
+ Boolean'Pos (State));
+ end Item_Select;
+
+
+ function Item_Selected
+ (This : in Check_Browser;
+ Item : in Item_Cursor)
+ return Boolean is
+ begin
+ return fl_check_browser_item_selected (This.Void_Ptr, Cursor_To_Address (Item)) /= 0;
+ end Item_Selected;
+
+
+ -- Note that Item_Swap and Item_Text are not implemented
+
+
+ procedure Item_Draw
+ (This : in Check_Browser;
+ Item : in Item_Cursor;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_check_browser_item_draw
+ (This.Void_Ptr,
+ Cursor_To_Address (Item),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Item_Draw;
+
+
+end FLTK.Widgets.Groups.Browsers.Check;
+
+
diff --git a/body/fltk-widgets-groups-browsers-textline-choice.adb b/body/fltk-widgets-groups-browsers-textline-choice.adb
new file mode 100644
index 0000000..95df2f2
--- /dev/null
+++ b/body/fltk-widgets-groups-browsers-textline-choice.adb
@@ -0,0 +1,249 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Groups.Browsers.Textline.Choice is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_select_browser
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_select_browser, "new_fl_select_browser");
+ pragma Inline (new_fl_select_browser);
+
+ procedure free_fl_select_browser
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_select_browser, "free_fl_select_browser");
+ pragma Inline (free_fl_select_browser);
+
+
+
+
+ function fl_select_browser_item_width
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_select_browser_item_width, "fl_select_browser_item_width");
+ pragma Inline (fl_select_browser_item_width);
+
+ function fl_select_browser_item_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_select_browser_item_height, "fl_select_browser_item_height");
+ pragma Inline (fl_select_browser_item_height);
+
+ function fl_select_browser_item_first
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_select_browser_item_first, "fl_select_browser_item_first");
+ pragma Inline (fl_select_browser_item_first);
+
+ function fl_select_browser_item_last
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_select_browser_item_last, "fl_select_browser_item_last");
+ pragma Inline (fl_select_browser_item_last);
+
+ function fl_select_browser_item_next
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_select_browser_item_next, "fl_select_browser_item_next");
+ pragma Inline (fl_select_browser_item_next);
+
+ function fl_select_browser_item_prev
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_select_browser_item_prev, "fl_select_browser_item_prev");
+ pragma Inline (fl_select_browser_item_prev);
+
+ function fl_select_browser_item_at
+ (B : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_select_browser_item_at, "fl_select_browser_item_at");
+ pragma Inline (fl_select_browser_item_at);
+
+ procedure fl_select_browser_item_select
+ (B, I : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_select_browser_item_select, "fl_select_browser_item_select");
+ pragma Inline (fl_select_browser_item_select);
+
+ function fl_select_browser_item_selected
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_select_browser_item_selected, "fl_select_browser_item_selected");
+ pragma Inline (fl_select_browser_item_selected);
+
+ procedure fl_select_browser_item_swap
+ (B, X, Y : in Storage.Integer_Address);
+ pragma Import (C, fl_select_browser_item_swap, "fl_select_browser_item_swap");
+ pragma Inline (fl_select_browser_item_swap);
+
+ function fl_select_browser_item_text
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_select_browser_item_text, "fl_select_browser_item_text");
+ pragma Inline (fl_select_browser_item_text);
+
+ procedure fl_select_browser_item_draw
+ (B, I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_select_browser_item_draw, "fl_select_browser_item_draw");
+ pragma Inline (fl_select_browser_item_draw);
+
+
+
+
+ function fl_select_browser_full_width
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_select_browser_full_width, "fl_select_browser_full_width");
+ pragma Inline (fl_select_browser_full_width);
+
+ function fl_select_browser_full_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_select_browser_full_height, "fl_select_browser_full_height");
+ pragma Inline (fl_select_browser_full_height);
+
+ function fl_select_browser_incr_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_select_browser_incr_height, "fl_select_browser_incr_height");
+ pragma Inline (fl_select_browser_incr_height);
+
+ function fl_select_browser_item_quick_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_select_browser_item_quick_height, "fl_select_browser_item_quick_height");
+ pragma Inline (fl_select_browser_item_quick_height);
+
+
+
+
+ procedure fl_select_browser_draw
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_select_browser_draw, "fl_select_browser_draw");
+ pragma Inline (fl_select_browser_draw);
+
+ function fl_select_browser_handle
+ (B : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_select_browser_handle, "fl_select_browser_handle");
+ pragma Inline (fl_select_browser_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Choice_Browser) is
+ begin
+ Extra_Final (Textline_Browser (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Choice_Browser) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_select_browser (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Choice_Browser;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Textline_Browser (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Choice_Browser) is
+ begin
+ This.Item_Override_Ptrs :=
+ (Item_Width_Ptr => fl_select_browser_item_width'Address,
+ Item_Height_Ptr => fl_select_browser_item_height'Address,
+ Item_First_Ptr => fl_select_browser_item_first'Address,
+ Item_Last_Ptr => fl_select_browser_item_last'Address,
+ Item_Next_Ptr => fl_select_browser_item_next'Address,
+ Item_Previous_Ptr => fl_select_browser_item_prev'Address,
+ Item_At_Ptr => fl_select_browser_item_at'Address,
+ Item_Select_Ptr => fl_select_browser_item_select'Address,
+ Item_Selected_Ptr => fl_select_browser_item_selected'Address,
+ Item_Swap_Ptr => fl_select_browser_item_swap'Address,
+ Item_Text_Ptr => fl_select_browser_item_text'Address,
+ Item_Draw_Ptr => fl_select_browser_item_draw'Address);
+ This.Wide_High_Ptrs :=
+ (Full_List_Width_Ptr => fl_select_browser_full_width'Address,
+ Full_List_Height_Ptr => fl_select_browser_full_height'Address,
+ Average_Item_Height_Ptr => fl_select_browser_incr_height'Address,
+ Item_Quick_Height_Ptr => fl_select_browser_item_quick_height'Address);
+ This.Draw_Ptr := fl_select_browser_draw'Address;
+ This.Handle_Ptr := fl_select_browser_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Choice_Browser is
+ begin
+ return This : Choice_Browser do
+ This.Void_Ptr := new_fl_select_browser
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Choice_Browser is
+ begin
+ return This : Choice_Browser := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Groups.Browsers.Textline.Choice;
+
+
diff --git a/body/fltk-widgets-groups-browsers-textline-file.adb b/body/fltk-widgets-groups-browsers-textline-file.adb
new file mode 100644
index 0000000..e45396c
--- /dev/null
+++ b/body/fltk-widgets-groups-browsers-textline-file.adb
@@ -0,0 +1,524 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets.Groups.Browsers.Textline.File is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function get_error_message
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, get_error_message, "get_error_message");
+ pragma Inline (get_error_message);
+
+ function filename_dname
+ (L : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, filename_dname, "filename_dname");
+ pragma Inline (filename_dname);
+
+
+
+
+ function new_fl_file_browser
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_file_browser, "new_fl_file_browser");
+ pragma Inline (new_fl_file_browser);
+
+ procedure free_fl_file_browser
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_file_browser, "free_fl_file_browser");
+ pragma Inline (free_fl_file_browser);
+
+
+
+
+ function fl_file_browser_load
+ (B : in Storage.Integer_Address;
+ D : in Interfaces.C.char_array;
+ S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_browser_load, "fl_file_browser_load");
+ pragma Inline (fl_file_browser_load);
+
+
+
+
+ function fl_file_browser_get_filetype
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_browser_get_filetype, "fl_file_browser_get_filetype");
+ pragma Inline (fl_file_browser_get_filetype);
+
+ procedure fl_file_browser_set_filetype
+ (B : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_file_browser_set_filetype, "fl_file_browser_set_filetype");
+ pragma Inline (fl_file_browser_set_filetype);
+
+ function fl_file_browser_get_filter
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_browser_get_filter, "fl_file_browser_get_filter");
+ pragma Inline (fl_file_browser_get_filter);
+
+ procedure fl_file_browser_set_filter
+ (B : in Storage.Integer_Address;
+ F : in Interfaces.C.char_array);
+ pragma Import (C, fl_file_browser_set_filter, "fl_file_browser_set_filter");
+ pragma Inline (fl_file_browser_set_filter);
+
+ function fl_file_browser_get_iconsize
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.unsigned_char;
+ pragma Import (C, fl_file_browser_get_iconsize, "fl_file_browser_get_iconsize");
+ pragma Inline (fl_file_browser_get_iconsize);
+
+ procedure fl_file_browser_set_iconsize
+ (B : in Storage.Integer_Address;
+ I : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_file_browser_set_iconsize, "fl_file_browser_set_iconsize");
+ pragma Inline (fl_file_browser_set_iconsize);
+
+ function fl_file_browser_get_textsize
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_browser_get_textsize, "fl_file_browser_get_textsize");
+ pragma Inline (fl_file_browser_get_textsize);
+
+ procedure fl_file_browser_set_textsize
+ (B : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_file_browser_set_textsize, "fl_file_browser_set_textsize");
+ pragma Inline (fl_file_browser_set_textsize);
+
+
+
+
+ function fl_file_browser_item_width
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_browser_item_width, "fl_file_browser_item_width");
+ pragma Inline (fl_file_browser_item_width);
+
+ function fl_file_browser_item_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_browser_item_height, "fl_file_browser_item_height");
+ pragma Inline (fl_file_browser_item_height);
+
+ function fl_file_browser_item_first
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_file_browser_item_first, "fl_file_browser_item_first");
+ pragma Inline (fl_file_browser_item_first);
+
+ function fl_file_browser_item_last
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_file_browser_item_last, "fl_file_browser_item_last");
+ pragma Inline (fl_file_browser_item_last);
+
+ function fl_file_browser_item_next
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_file_browser_item_next, "fl_file_browser_item_next");
+ pragma Inline (fl_file_browser_item_next);
+
+ function fl_file_browser_item_prev
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_file_browser_item_prev, "fl_file_browser_item_prev");
+ pragma Inline (fl_file_browser_item_prev);
+
+ function fl_file_browser_item_at
+ (B : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_file_browser_item_at, "fl_file_browser_item_at");
+ pragma Inline (fl_file_browser_item_at);
+
+ procedure fl_file_browser_item_select
+ (B, I : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_file_browser_item_select, "fl_file_browser_item_select");
+ pragma Inline (fl_file_browser_item_select);
+
+ function fl_file_browser_item_selected
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_browser_item_selected, "fl_file_browser_item_selected");
+ pragma Inline (fl_file_browser_item_selected);
+
+ procedure fl_file_browser_item_swap
+ (B, X, Y : in Storage.Integer_Address);
+ pragma Import (C, fl_file_browser_item_swap, "fl_file_browser_item_swap");
+ pragma Inline (fl_file_browser_item_swap);
+
+ function fl_file_browser_item_text
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_browser_item_text, "fl_file_browser_item_text");
+ pragma Inline (fl_file_browser_item_text);
+
+ procedure fl_file_browser_item_draw
+ (B, I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_file_browser_item_draw, "fl_file_browser_item_draw");
+ pragma Inline (fl_file_browser_item_draw);
+
+
+
+
+ function fl_file_browser_full_width
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_browser_full_width, "fl_file_browser_full_width");
+ pragma Inline (fl_file_browser_full_width);
+
+ function fl_file_browser_full_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_browser_full_height, "fl_file_browser_full_height");
+ pragma Inline (fl_file_browser_full_height);
+
+ function fl_file_browser_incr_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_browser_incr_height, "fl_file_browser_incr_height");
+ pragma Inline (fl_file_browser_incr_height);
+
+ function fl_file_browser_item_quick_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_browser_item_quick_height, "fl_file_browser_item_quick_height");
+ pragma Inline (fl_file_browser_item_quick_height);
+
+
+
+
+ procedure fl_file_browser_draw
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_file_browser_draw, "fl_file_browser_draw");
+ pragma Inline (fl_file_browser_draw);
+
+ function fl_file_browser_handle
+ (B : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_browser_handle, "fl_file_browser_handle");
+ pragma Inline (fl_file_browser_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out File_Browser) is
+ begin
+ Extra_Final (Textline_Browser (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out File_Browser) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_file_browser (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out File_Browser;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Textline_Browser (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out File_Browser) is
+ begin
+ This.Item_Override_Ptrs :=
+ (Item_Width_Ptr => fl_file_browser_item_width'Address,
+ Item_Height_Ptr => fl_file_browser_item_height'Address,
+ Item_First_Ptr => fl_file_browser_item_first'Address,
+ Item_Last_Ptr => fl_file_browser_item_last'Address,
+ Item_Next_Ptr => fl_file_browser_item_next'Address,
+ Item_Previous_Ptr => fl_file_browser_item_prev'Address,
+ Item_At_Ptr => fl_file_browser_item_at'Address,
+ Item_Select_Ptr => fl_file_browser_item_select'Address,
+ Item_Selected_Ptr => fl_file_browser_item_selected'Address,
+ Item_Swap_Ptr => fl_file_browser_item_swap'Address,
+ Item_Text_Ptr => fl_file_browser_item_text'Address,
+ Item_Draw_Ptr => fl_file_browser_item_draw'Address);
+ This.Wide_High_Ptrs :=
+ (Full_List_Width_Ptr => fl_file_browser_full_width'Address,
+ Full_List_Height_Ptr => fl_file_browser_full_height'Address,
+ Average_Item_Height_Ptr => fl_file_browser_incr_height'Address,
+ Item_Quick_Height_Ptr => fl_file_browser_item_quick_height'Address);
+ This.Draw_Ptr := fl_file_browser_draw'Address;
+ This.Handle_Ptr := fl_file_browser_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return File_Browser is
+ begin
+ return This : File_Browser do
+ This.Void_Ptr := new_fl_file_browser
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return File_Browser is
+ begin
+ return This : File_Browser := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ Current_Sort : FLTK.Filenames.Compare_Function;
+
+ function Compare_Hook
+ (DA, DB : in Storage.Integer_Address)
+ return Interfaces.C.int;
+
+ pragma Convention (C, Compare_Hook);
+
+ function Compare_Hook
+ (DA, DB : in Storage.Integer_Address)
+ return Interfaces.C.int
+ is
+ Result : FLTK.Filenames.Comparison := Current_Sort
+ (Interfaces.C.Strings.Value (filename_dname (DA, 0)),
+ Interfaces.C.Strings.Value (filename_dname (DB, 0)));
+ begin
+ return FLTK.Filenames.Comparison'Pos (Result) - 1;
+ end Compare_Hook;
+
+
+ function Load
+ (This : in out File_Browser;
+ Dir : in String;
+ Sort : in not null FLTK.Filenames.Compare_Function :=
+ FLTK.Filenames.Numeric_Sort'Access)
+ return Natural
+ is
+ Msg : Interfaces.C.Strings.chars_ptr;
+ Code : Interfaces.C.int;
+ begin
+ Current_Sort := Sort;
+ Code := fl_file_browser_load
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Dir),
+ Storage.To_Integer (Compare_Hook'Address));
+ if Code = 0 then
+ Msg := get_error_message;
+ if Msg /= Interfaces.C.Strings.Null_Ptr then
+ raise Browser_Load_Error with Interfaces.C.Strings.Value (Msg);
+ end if;
+ end if;
+ return Natural (Code);
+ end Load;
+
+
+ procedure Load
+ (This : in out File_Browser;
+ Dir : in String;
+ Sort : in not null FLTK.Filenames.Compare_Function :=
+ FLTK.Filenames.Numeric_Sort'Access)
+ is
+ Result : Natural := This.Load (Dir, Sort);
+ begin
+ null;
+ end Load;
+
+
+
+
+ function Get_File_Kind
+ (This : in File_Browser)
+ return File_Kind
+ is
+ Code : Interfaces.C.int := fl_file_browser_get_filetype (This.Void_Ptr);
+ begin
+ pragma Assert (Code in File_Kind'Pos (File_Kind'First) .. File_Kind'Pos (File_Kind'Last));
+ return File_Kind'Val (Code);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_File_Kind;
+
+
+ procedure Set_File_Kind
+ (This : in out File_Browser;
+ Value : in File_Kind) is
+ begin
+ fl_file_browser_set_filetype (This.Void_Ptr, File_Kind'Pos (Value));
+ end Set_File_Kind;
+
+
+ function Get_Filter
+ (This : in File_Browser)
+ return String
+ is
+ Result : Interfaces.C.Strings.chars_ptr := fl_file_browser_get_filter (This.Void_Ptr);
+ begin
+ if Result = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Result);
+ end if;
+ end Get_Filter;
+
+
+ procedure Set_Filter
+ (This : in out File_Browser;
+ Value : in String) is
+ begin
+ fl_file_browser_set_filter (This.Void_Ptr, Interfaces.C.To_C (Value));
+ end Set_Filter;
+
+
+ function Get_Icon_Size
+ (This : in File_Browser)
+ return Icon_Size is
+ begin
+ return Icon_Size (fl_file_browser_get_iconsize (This.Void_Ptr));
+ end Get_Icon_Size;
+
+
+ procedure Set_Icon_Size
+ (This : in out File_Browser;
+ Value : in Icon_Size) is
+ begin
+ fl_file_browser_set_iconsize (This.Void_Ptr, Interfaces.C.unsigned_char (Value));
+ end Set_Icon_Size;
+
+
+ function Get_Text_Size
+ (This : in File_Browser)
+ return Font_Size is
+ begin
+ return Font_Size (fl_file_browser_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out File_Browser;
+ Size : in Font_Size) is
+ begin
+ fl_file_browser_set_textsize (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Text_Size;
+
+
+
+
+ function Full_List_Height
+ (This : in File_Browser)
+ return Integer is
+ begin
+ return Textline_Browser (This).Full_List_Height;
+ end Full_List_Height;
+
+
+ function Average_Item_Height
+ (This : in File_Browser)
+ return Integer is
+ begin
+ return Textline_Browser (This).Average_Item_Height;
+ end Average_Item_Height;
+
+
+
+
+ function Item_Width
+ (This : in File_Browser;
+ Item : in Item_Cursor)
+ return Integer is
+ begin
+ return Textline_Browser (This).Item_Width (Item);
+ end Item_Width;
+
+
+ function Item_Height
+ (This : in File_Browser;
+ Item : in Item_Cursor)
+ return Integer is
+ begin
+ return Textline_Browser (This).Item_Height (Item);
+ end Item_Height;
+
+
+ procedure Item_Draw
+ (This : in File_Browser;
+ Item : in Item_Cursor;
+ X, Y, W, H : in Integer) is
+ begin
+ Textline_Browser (This).Item_Draw (Item, X, Y, W, H);
+ end Item_Draw;
+
+
+end FLTK.Widgets.Groups.Browsers.Textline.File;
+
+
diff --git a/body/fltk-widgets-groups-browsers-textline-hold.adb b/body/fltk-widgets-groups-browsers-textline-hold.adb
new file mode 100644
index 0000000..4c91322
--- /dev/null
+++ b/body/fltk-widgets-groups-browsers-textline-hold.adb
@@ -0,0 +1,250 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Groups.Browsers.Textline.Hold is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_hold_browser
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_hold_browser, "new_fl_hold_browser");
+ pragma Inline (new_fl_hold_browser);
+
+ procedure free_fl_hold_browser
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_hold_browser, "free_fl_hold_browser");
+ pragma Inline (free_fl_hold_browser);
+
+
+
+
+
+ function fl_hold_browser_item_width
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_hold_browser_item_width, "fl_hold_browser_item_width");
+ pragma Inline (fl_hold_browser_item_width);
+
+ function fl_hold_browser_item_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_hold_browser_item_height, "fl_hold_browser_item_height");
+ pragma Inline (fl_hold_browser_item_height);
+
+ function fl_hold_browser_item_first
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_hold_browser_item_first, "fl_hold_browser_item_first");
+ pragma Inline (fl_hold_browser_item_first);
+
+ function fl_hold_browser_item_last
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_hold_browser_item_last, "fl_hold_browser_item_last");
+ pragma Inline (fl_hold_browser_item_last);
+
+ function fl_hold_browser_item_next
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_hold_browser_item_next, "fl_hold_browser_item_next");
+ pragma Inline (fl_hold_browser_item_next);
+
+ function fl_hold_browser_item_prev
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_hold_browser_item_prev, "fl_hold_browser_item_prev");
+ pragma Inline (fl_hold_browser_item_prev);
+
+ function fl_hold_browser_item_at
+ (B : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_hold_browser_item_at, "fl_hold_browser_item_at");
+ pragma Inline (fl_hold_browser_item_at);
+
+ procedure fl_hold_browser_item_select
+ (B, I : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_hold_browser_item_select, "fl_hold_browser_item_select");
+ pragma Inline (fl_hold_browser_item_select);
+
+ function fl_hold_browser_item_selected
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_hold_browser_item_selected, "fl_hold_browser_item_selected");
+ pragma Inline (fl_hold_browser_item_selected);
+
+ procedure fl_hold_browser_item_swap
+ (B, X, Y : in Storage.Integer_Address);
+ pragma Import (C, fl_hold_browser_item_swap, "fl_hold_browser_item_swap");
+ pragma Inline (fl_hold_browser_item_swap);
+
+ function fl_hold_browser_item_text
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_hold_browser_item_text, "fl_hold_browser_item_text");
+ pragma Inline (fl_hold_browser_item_text);
+
+ procedure fl_hold_browser_item_draw
+ (B, I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_hold_browser_item_draw, "fl_hold_browser_item_draw");
+ pragma Inline (fl_hold_browser_item_draw);
+
+
+
+
+ function fl_hold_browser_full_width
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_hold_browser_full_width, "fl_hold_browser_full_width");
+ pragma Inline (fl_hold_browser_full_width);
+
+ function fl_hold_browser_full_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_hold_browser_full_height, "fl_hold_browser_full_height");
+ pragma Inline (fl_hold_browser_full_height);
+
+ function fl_hold_browser_incr_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_hold_browser_incr_height, "fl_hold_browser_incr_height");
+ pragma Inline (fl_hold_browser_incr_height);
+
+ function fl_hold_browser_item_quick_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_hold_browser_item_quick_height, "fl_hold_browser_item_quick_height");
+ pragma Inline (fl_hold_browser_item_quick_height);
+
+
+
+
+ procedure fl_hold_browser_draw
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_hold_browser_draw, "fl_hold_browser_draw");
+ pragma Inline (fl_hold_browser_draw);
+
+ function fl_hold_browser_handle
+ (B : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_hold_browser_handle, "fl_hold_browser_handle");
+ pragma Inline (fl_hold_browser_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Hold_Browser) is
+ begin
+ Extra_Final (Textline_Browser (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Hold_Browser) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_hold_browser (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Hold_Browser;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Textline_Browser (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Hold_Browser) is
+ begin
+ This.Item_Override_Ptrs :=
+ (Item_Width_Ptr => fl_hold_browser_item_width'Address,
+ Item_Height_Ptr => fl_hold_browser_item_height'Address,
+ Item_First_Ptr => fl_hold_browser_item_first'Address,
+ Item_Last_Ptr => fl_hold_browser_item_last'Address,
+ Item_Next_Ptr => fl_hold_browser_item_next'Address,
+ Item_Previous_Ptr => fl_hold_browser_item_prev'Address,
+ Item_At_Ptr => fl_hold_browser_item_at'Address,
+ Item_Select_Ptr => fl_hold_browser_item_select'Address,
+ Item_Selected_Ptr => fl_hold_browser_item_selected'Address,
+ Item_Swap_Ptr => fl_hold_browser_item_swap'Address,
+ Item_Text_Ptr => fl_hold_browser_item_text'Address,
+ Item_Draw_Ptr => fl_hold_browser_item_draw'Address);
+ This.Wide_High_Ptrs :=
+ (Full_List_Width_Ptr => fl_hold_browser_full_width'Address,
+ Full_List_Height_Ptr => fl_hold_browser_full_height'Address,
+ Average_Item_Height_Ptr => fl_hold_browser_incr_height'Address,
+ Item_Quick_Height_Ptr => fl_hold_browser_item_quick_height'Address);
+ This.Draw_Ptr := fl_hold_browser_draw'Address;
+ This.Handle_Ptr := fl_hold_browser_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Hold_Browser is
+ begin
+ return This : Hold_Browser do
+ This.Void_Ptr := new_fl_hold_browser
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Hold_Browser is
+ begin
+ return This : Hold_Browser := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Groups.Browsers.Textline.Hold;
+
+
diff --git a/body/fltk-widgets-groups-browsers-textline-multi.adb b/body/fltk-widgets-groups-browsers-textline-multi.adb
new file mode 100644
index 0000000..ddcfd0a
--- /dev/null
+++ b/body/fltk-widgets-groups-browsers-textline-multi.adb
@@ -0,0 +1,249 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Groups.Browsers.Textline.Multi is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_multi_browser
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_multi_browser, "new_fl_multi_browser");
+ pragma Inline (new_fl_multi_browser);
+
+ procedure free_fl_multi_browser
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_multi_browser, "free_fl_multi_browser");
+ pragma Inline (free_fl_multi_browser);
+
+
+
+
+ function fl_multi_browser_item_width
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_multi_browser_item_width, "fl_multi_browser_item_width");
+ pragma Inline (fl_multi_browser_item_width);
+
+ function fl_multi_browser_item_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_multi_browser_item_height, "fl_multi_browser_item_height");
+ pragma Inline (fl_multi_browser_item_height);
+
+ function fl_multi_browser_item_first
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_multi_browser_item_first, "fl_multi_browser_item_first");
+ pragma Inline (fl_multi_browser_item_first);
+
+ function fl_multi_browser_item_last
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_multi_browser_item_last, "fl_multi_browser_item_last");
+ pragma Inline (fl_multi_browser_item_last);
+
+ function fl_multi_browser_item_next
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_multi_browser_item_next, "fl_multi_browser_item_next");
+ pragma Inline (fl_multi_browser_item_next);
+
+ function fl_multi_browser_item_prev
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_multi_browser_item_prev, "fl_multi_browser_item_prev");
+ pragma Inline (fl_multi_browser_item_prev);
+
+ function fl_multi_browser_item_at
+ (B : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_multi_browser_item_at, "fl_multi_browser_item_at");
+ pragma Inline (fl_multi_browser_item_at);
+
+ procedure fl_multi_browser_item_select
+ (B, I : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_multi_browser_item_select, "fl_multi_browser_item_select");
+ pragma Inline (fl_multi_browser_item_select);
+
+ function fl_multi_browser_item_selected
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_multi_browser_item_selected, "fl_multi_browser_item_selected");
+ pragma Inline (fl_multi_browser_item_selected);
+
+ procedure fl_multi_browser_item_swap
+ (B, X, Y : in Storage.Integer_Address);
+ pragma Import (C, fl_multi_browser_item_swap, "fl_multi_browser_item_swap");
+ pragma Inline (fl_multi_browser_item_swap);
+
+ function fl_multi_browser_item_text
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_multi_browser_item_text, "fl_multi_browser_item_text");
+ pragma Inline (fl_multi_browser_item_text);
+
+ procedure fl_multi_browser_item_draw
+ (B, I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_multi_browser_item_draw, "fl_multi_browser_item_draw");
+ pragma Inline (fl_multi_browser_item_draw);
+
+
+
+
+ function fl_multi_browser_full_width
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_multi_browser_full_width, "fl_multi_browser_full_width");
+ pragma Inline (fl_multi_browser_full_width);
+
+ function fl_multi_browser_full_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_multi_browser_full_height, "fl_multi_browser_full_height");
+ pragma Inline (fl_multi_browser_full_height);
+
+ function fl_multi_browser_incr_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_multi_browser_incr_height, "fl_multi_browser_incr_height");
+ pragma Inline (fl_multi_browser_incr_height);
+
+ function fl_multi_browser_item_quick_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_multi_browser_item_quick_height, "fl_multi_browser_item_quick_height");
+ pragma Inline (fl_multi_browser_item_quick_height);
+
+
+
+
+ procedure fl_multi_browser_draw
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_multi_browser_draw, "fl_multi_browser_draw");
+ pragma Inline (fl_multi_browser_draw);
+
+ function fl_multi_browser_handle
+ (B : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_multi_browser_handle, "fl_multi_browser_handle");
+ pragma Inline (fl_multi_browser_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Multi_Browser) is
+ begin
+ Extra_Final (Textline_Browser (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Multi_Browser) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_multi_browser (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Multi_Browser;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Textline_Browser (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Multi_Browser) is
+ begin
+ This.Item_Override_Ptrs :=
+ (Item_Width_Ptr => fl_multi_browser_item_width'Address,
+ Item_Height_Ptr => fl_multi_browser_item_height'Address,
+ Item_First_Ptr => fl_multi_browser_item_first'Address,
+ Item_Last_Ptr => fl_multi_browser_item_last'Address,
+ Item_Next_Ptr => fl_multi_browser_item_next'Address,
+ Item_Previous_Ptr => fl_multi_browser_item_prev'Address,
+ Item_At_Ptr => fl_multi_browser_item_at'Address,
+ Item_Select_Ptr => fl_multi_browser_item_select'Address,
+ Item_Selected_Ptr => fl_multi_browser_item_selected'Address,
+ Item_Swap_Ptr => fl_multi_browser_item_swap'Address,
+ Item_Text_Ptr => fl_multi_browser_item_text'Address,
+ Item_Draw_Ptr => fl_multi_browser_item_draw'Address);
+ This.Wide_High_Ptrs :=
+ (Full_List_Width_Ptr => fl_multi_browser_full_width'Address,
+ Full_List_Height_Ptr => fl_multi_browser_full_height'Address,
+ Average_Item_Height_Ptr => fl_multi_browser_incr_height'Address,
+ Item_Quick_Height_Ptr => fl_multi_browser_item_quick_height'Address);
+ This.Draw_Ptr := fl_multi_browser_draw'Address;
+ This.Handle_Ptr := fl_multi_browser_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Multi_Browser is
+ begin
+ return This : Multi_Browser do
+ This.Void_Ptr := new_fl_multi_browser
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Multi_Browser is
+ begin
+ return This : Multi_Browser := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Groups.Browsers.Textline.Multi;
+
+
diff --git a/body/fltk-widgets-groups-browsers-textline.adb b/body/fltk-widgets-groups-browsers-textline.adb
new file mode 100644
index 0000000..b7b3077
--- /dev/null
+++ b/body/fltk-widgets-groups-browsers-textline.adb
@@ -0,0 +1,1195 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Ada.Unchecked_Deallocation,
+ FLTK.Images,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets.Groups.Browsers.Textline is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function get_error_message
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, get_error_message, "get_error_message");
+ pragma Inline (get_error_message);
+
+
+
+
+ function new_fl_browser
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_browser, "new_fl_browser");
+ pragma Inline (new_fl_browser);
+
+ procedure free_fl_browser
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_browser, "free_fl_browser");
+ pragma Inline (free_fl_browser);
+
+
+
+
+ procedure fl_browser_add
+ (B : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array;
+ D : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_add, "fl_browser_add");
+ pragma Inline (fl_browser_add);
+
+ procedure fl_browser_insert
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int;
+ T : in Interfaces.C.char_array;
+ D : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_insert, "fl_browser_insert");
+ pragma Inline (fl_browser_insert);
+
+ procedure fl_browser_move
+ (B : in Storage.Integer_Address;
+ T, F : in Interfaces.C.int);
+ pragma Import (C, fl_browser_move, "fl_browser_move");
+ pragma Inline (fl_browser_move);
+
+ procedure fl_browser_swap
+ (B : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_browser_swap, "fl_browser_swap");
+ pragma Inline (fl_browser_swap);
+
+ procedure fl_browser_remove
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_remove, "fl_browser_remove");
+ pragma Inline (fl_browser_remove);
+
+ procedure fl_browser_clear
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_clear, "fl_browser_clear");
+ pragma Inline (fl_browser_clear);
+
+ function fl_browser_size
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_size, "fl_browser_size");
+ pragma Inline (fl_browser_size);
+
+
+
+
+ function fl_browser_load
+ (B : in Storage.Integer_Address;
+ F : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_load, "fl_browser_load");
+ pragma Inline (fl_browser_load);
+
+ function fl_browser_get_text
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_browser_get_text, "fl_browser_get_text");
+ pragma Inline (fl_browser_get_text);
+
+ procedure fl_browser_set_text
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_browser_set_text, "fl_browser_set_text");
+ pragma Inline (fl_browser_set_text);
+
+ function fl_browser_get_textsize
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_get_textsize, "fl_browser_get_textsize");
+ pragma Inline (fl_browser_get_textsize);
+
+ procedure fl_browser_set_textsize
+ (B : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_browser_set_textsize, "fl_browser_set_textsize");
+ pragma Inline (fl_browser_set_textsize);
+
+
+
+
+ function fl_browser_get_column_char
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.char;
+ pragma Import (C, fl_browser_get_column_char, "fl_browser_get_column_char");
+ pragma Inline (fl_browser_get_column_char);
+
+ procedure fl_browser_set_column_char
+ (B : in Storage.Integer_Address;
+ C : in Interfaces.C.char);
+ pragma Import (C, fl_browser_set_column_char, "fl_browser_set_column_char");
+ pragma Inline (fl_browser_set_column_char);
+
+ procedure fl_browser_set_column_widths
+ (B, W : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_set_column_widths, "fl_browser_set_column_widths");
+ pragma Inline (fl_browser_set_column_widths);
+
+ function fl_browser_get_format_char
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.char;
+ pragma Import (C, fl_browser_get_format_char, "fl_browser_get_format_char");
+ pragma Inline (fl_browser_get_format_char);
+
+ procedure fl_browser_set_format_char
+ (B : in Storage.Integer_Address;
+ C : in Interfaces.C.char);
+ pragma Import (C, fl_browser_set_format_char, "fl_browser_set_format_char");
+ pragma Inline (fl_browser_set_format_char);
+
+
+
+
+ function fl_browser_get_topline
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_get_topline, "fl_browser_get_topline");
+ pragma Inline (fl_browser_get_topline);
+
+ procedure fl_browser_set_topline
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_set_topline, "fl_browser_set_topline");
+ pragma Inline (fl_browser_set_topline);
+
+ procedure fl_browser_middleline
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_middleline, "fl_browser_middleline");
+ pragma Inline (fl_browser_middleline);
+
+ procedure fl_browser_bottomline
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_bottomline, "fl_browser_bottomline");
+ pragma Inline (fl_browser_bottomline);
+
+ procedure fl_browser_lineposition
+ (B : in Storage.Integer_Address;
+ L, P : in Interfaces.C.int);
+ pragma Import (C, fl_browser_lineposition, "fl_browser_lineposition");
+ pragma Inline (fl_browser_lineposition);
+
+
+
+
+ function fl_browser_select
+ (B : in Storage.Integer_Address;
+ L, V : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_select, "fl_browser_select");
+ pragma Inline (fl_browser_select);
+
+ function fl_browser_selected
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_selected, "fl_browser_selected");
+ pragma Inline (fl_browser_selected);
+
+ function fl_browser_value
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_value, "fl_browser_value");
+ pragma Inline (fl_browser_value);
+
+
+
+
+ function fl_browser_visible
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_visible, "fl_browser_visible");
+ pragma Inline (fl_browser_visible);
+
+ procedure fl_browser_make_visible
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_make_visible, "fl_browser_make_visible");
+ pragma Inline (fl_browser_make_visible);
+
+ function fl_browser_displayed
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_displayed, "fl_browser_displayed");
+ pragma Inline (fl_browser_displayed);
+
+ procedure fl_browser_show_line
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_show_line, "fl_browser_show_line");
+ pragma Inline (fl_browser_show_line);
+
+ procedure fl_browser_hide_line
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_hide_line, "fl_browser_hide_line");
+ pragma Inline (fl_browser_hide_line);
+
+ procedure fl_browser_show
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_show, "fl_browser_show");
+ pragma Inline (fl_browser_show);
+
+ procedure fl_browser_hide
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_hide, "fl_browser_hide");
+ pragma Inline (fl_browser_hide);
+
+
+
+
+ procedure fl_browser_set_size
+ (B : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int);
+ pragma Import (C, fl_browser_set_size, "fl_browser_set_size");
+ pragma Inline (fl_browser_set_size);
+
+
+
+
+ procedure fl_browser_set_icon
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int;
+ C : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_set_icon, "fl_browser_set_icon");
+ pragma Inline (fl_browser_set_icon);
+
+ procedure fl_browser_remove_icon
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_remove_icon, "fl_browser_remove_icon");
+ pragma Inline (fl_browser_remove_icon);
+
+
+
+
+ function fl_browser_item_width
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_item_width, "fl_browser_item_width");
+ pragma Inline (fl_browser_item_width);
+
+ function fl_browser_item_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_item_height, "fl_browser_item_height");
+ pragma Inline (fl_browser_item_height);
+
+ function fl_browser_item_first
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_item_first, "fl_browser_item_first");
+ pragma Inline (fl_browser_item_first);
+
+ function fl_browser_item_last
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_item_last, "fl_browser_item_last");
+ pragma Inline (fl_browser_item_last);
+
+ function fl_browser_item_next
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_item_next, "fl_browser_item_next");
+ pragma Inline (fl_browser_item_next);
+
+ function fl_browser_item_prev
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_item_prev, "fl_browser_item_prev");
+ pragma Inline (fl_browser_item_prev);
+
+ function fl_browser_item_at
+ (B : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_item_at, "fl_browser_item_at");
+ pragma Inline (fl_browser_item_at);
+
+ procedure fl_browser_item_select
+ (B, I : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_browser_item_select, "fl_browser_item_select");
+ pragma Inline (fl_browser_item_select);
+
+ function fl_browser_item_selected
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_item_selected, "fl_browser_item_selected");
+ pragma Inline (fl_browser_item_selected);
+
+ procedure fl_browser_item_swap
+ (B, X, Y : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_item_swap, "fl_browser_item_swap");
+ pragma Inline (fl_browser_item_swap);
+
+ function fl_browser_item_text
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_browser_item_text, "fl_browser_item_text");
+ pragma Inline (fl_browser_item_text);
+
+ procedure fl_browser_item_draw
+ (B, I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_browser_item_draw, "fl_browser_item_draw");
+ pragma Inline (fl_browser_item_draw);
+
+
+
+
+ function fl_browser_full_width
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_full_width, "fl_browser_full_width");
+ pragma Inline (fl_browser_full_width);
+
+ function fl_browser_full_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_full_height, "fl_browser_full_height");
+ pragma Inline (fl_browser_full_height);
+
+ function fl_browser_incr_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_incr_height, "fl_browser_incr_height");
+ pragma Inline (fl_browser_incr_height);
+
+ function fl_browser_item_quick_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_item_quick_height, "fl_browser_item_quick_height");
+ pragma Inline (fl_browser_item_quick_height);
+
+
+
+
+ function fl_browser_lineno
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_lineno, "fl_browser_lineno");
+ pragma Inline (fl_browser_lineno);
+
+
+
+
+ procedure fl_browser_draw
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_draw, "fl_browser_draw");
+ pragma Inline (fl_browser_draw);
+
+ function fl_browser_handle
+ (B : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_handle, "fl_browser_handle");
+ pragma Inline (fl_browser_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Object => C_Col_Widths,
+ Name => C_Col_Widths_Access);
+
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Object => FLTK.Images.Image'Class,
+ Name => Image_Access);
+
+
+ procedure Extra_Final
+ (This : in out Textline_Browser) is
+ begin
+ Free (This.Columns);
+ for Icon_Ptr of This.Icons loop
+ Free (Icon_Ptr);
+ end loop;
+ Extra_Final (Browser (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Textline_Browser) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_browser (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Textline_Browser;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Browser (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Textline_Browser) is
+ begin
+ This.Item_Override_Ptrs :=
+ (Item_Width_Ptr => fl_browser_item_width'Address,
+ Item_Height_Ptr => fl_browser_item_height'Address,
+ Item_First_Ptr => fl_browser_item_first'Address,
+ Item_Last_Ptr => fl_browser_item_last'Address,
+ Item_Next_Ptr => fl_browser_item_next'Address,
+ Item_Previous_Ptr => fl_browser_item_prev'Address,
+ Item_At_Ptr => fl_browser_item_at'Address,
+ Item_Select_Ptr => fl_browser_item_select'Address,
+ Item_Selected_Ptr => fl_browser_item_selected'Address,
+ Item_Swap_Ptr => fl_browser_item_swap'Address,
+ Item_Text_Ptr => fl_browser_item_text'Address,
+ Item_Draw_Ptr => fl_browser_item_draw'Address);
+ This.Wide_High_Ptrs :=
+ (Full_List_Width_Ptr => fl_browser_full_width'Address,
+ Full_List_Height_Ptr => fl_browser_full_height'Address,
+ Average_Item_Height_Ptr => fl_browser_incr_height'Address,
+ Item_Quick_Height_Ptr => fl_browser_item_quick_height'Address);
+ This.Draw_Ptr := fl_browser_draw'Address;
+ This.Handle_Ptr := fl_browser_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Textline_Browser is
+ begin
+ return This : Textline_Browser do
+ This.Void_Ptr := new_fl_browser
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Textline_Browser is
+ begin
+ return This : Textline_Browser := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Add
+ (This : in out Textline_Browser;
+ Text : in String) is
+ begin
+ fl_browser_add
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ Null_Pointer);
+ end Add;
+
+
+ procedure Insert
+ (This : in out Textline_Browser;
+ Above : in Positive;
+ Text : in String) is
+ begin
+ fl_browser_insert
+ (This.Void_Ptr,
+ Interfaces.C.int (Above),
+ Interfaces.C.To_C (Text),
+ Null_Pointer);
+ end Insert;
+
+
+ procedure Move
+ (This : in out Textline_Browser;
+ From, To : in Positive) is
+ begin
+ fl_browser_move
+ (This.Void_Ptr,
+ Interfaces.C.int (To),
+ Interfaces.C.int (From));
+ end Move;
+
+
+ procedure Swap
+ (This : in out Textline_Browser;
+ A, B : in Positive) is
+ begin
+ fl_browser_swap
+ (This.Void_Ptr,
+ Interfaces.C.int (A),
+ Interfaces.C.int (B));
+ end Swap;
+
+
+ procedure Remove
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_remove
+ (This.Void_Ptr,
+ Interfaces.C.int (Line));
+ end Remove;
+
+
+ procedure Clear
+ (This : in out Textline_Browser) is
+ begin
+ fl_browser_clear (This.Void_Ptr);
+ end Clear;
+
+
+ function Number_Of_Lines
+ (This : in Textline_Browser)
+ return Natural is
+ begin
+ return Natural (fl_browser_size (This.Void_Ptr));
+ end Number_Of_Lines;
+
+
+
+
+ procedure Load
+ (This : in out Textline_Browser;
+ File : in String)
+ is
+ Msg : Interfaces.C.Strings.chars_ptr;
+ Code : Interfaces.C.int := fl_browser_load (This.Void_Ptr, Interfaces.C.To_C (File));
+ begin
+ if Code = 0 then
+ Msg := get_error_message;
+ if Msg = Interfaces.C.Strings.Null_Ptr then
+ raise Browser_Load_Error;
+ else
+ raise Browser_Load_Error with Interfaces.C.Strings.Value (Msg);
+ end if;
+ else
+ pragma Assert (Code = 1);
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Load;
+
+
+ function Get_Line_Text
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_browser_get_text
+ (This.Void_Ptr,
+ Interfaces.C.int (Line));
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Get_Line_Text;
+
+
+ procedure Set_Line_Text
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Text : in String) is
+ begin
+ fl_browser_set_text
+ (This.Void_Ptr,
+ Interfaces.C.int (Line),
+ Interfaces.C.To_C (Text));
+ end Set_Line_Text;
+
+
+ function Get_Text_Size
+ (This : in Textline_Browser)
+ return Font_Size is
+ begin
+ return Font_Size (fl_browser_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Textline_Browser;
+ Size : in Font_Size) is
+ begin
+ fl_browser_set_textsize (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Text_Size;
+
+
+
+
+ function Get_Column_Character
+ (This : in Textline_Browser)
+ return Character is
+ begin
+ return Interfaces.C.To_Ada (fl_browser_get_column_char (This.Void_Ptr));
+ end Get_Column_Character;
+
+
+ procedure Set_Column_Character
+ (This : in out Textline_Browser;
+ Value : in Character) is
+ begin
+ fl_browser_set_column_char (This.Void_Ptr, Interfaces.C.To_C (Value));
+ end Set_Column_Character;
+
+
+ function Get_Column_Widths
+ (This : in Textline_Browser)
+ return Column_Widths is
+ begin
+ if This.Columns = null then
+ return Result : Column_Widths (1 .. 0);
+ else
+ return Result : Column_Widths (This.Columns'First .. This.Columns'Last - 1) do
+ for Index in Result'Range loop
+ Result (Index) := Integer (This.Columns (Index));
+ end loop;
+ end return;
+ end if;
+ end Get_Column_Widths;
+
+
+ procedure Set_Column_Widths
+ (This : in out Textline_Browser;
+ Widths : in Column_Widths) is
+ begin
+ Free (This.Columns);
+ This.Columns := new C_Col_Widths (1 .. Widths'Length + 1);
+ for Index in This.Columns'Range loop
+ This.Columns (Index) := Interfaces.C.int (Widths (Widths'First + Index - 1));
+ end loop;
+ This.Columns (This.Columns'Last) := 0;
+ fl_browser_set_column_widths (This.Void_Ptr, Storage.To_Integer (This.Columns.all'Address));
+ end Set_Column_Widths;
+
+
+ function Get_Format_Character
+ (This : in Textline_Browser)
+ return Character is
+ begin
+ return Interfaces.C.To_Ada (fl_browser_get_format_char (This.Void_Ptr));
+ end Get_Format_Character;
+
+
+ procedure Set_Format_Character
+ (This : in out Textline_Browser;
+ Value : in Character) is
+ begin
+ fl_browser_set_format_char (This.Void_Ptr, Interfaces.C.To_C (Value));
+ end Set_Format_Character;
+
+
+
+
+ function Get_Top_Line
+ (This : in Textline_Browser)
+ return Positive is
+ begin
+ return Positive (fl_browser_get_topline (This.Void_Ptr));
+ end Get_Top_Line;
+
+
+ procedure Set_Top_Line
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_set_topline (This.Void_Ptr, Interfaces.C.int (Line));
+ end Set_Top_Line;
+
+
+ procedure Set_Middle_Line
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_middleline (This.Void_Ptr, Interfaces.C.int (Line));
+ end Set_Middle_Line;
+
+
+ procedure Set_Bottom_Line
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_bottomline (This.Void_Ptr, Interfaces.C.int (Line));
+ end Set_Bottom_Line;
+
+
+ procedure Set_Line_Position
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Place : in Line_Position) is
+ begin
+ fl_browser_lineposition (This.Void_Ptr, Interfaces.C.int (Line), Line_Position'Pos (Place));
+ end Set_Line_Position;
+
+
+
+
+ function Set_Select
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ State : in Boolean := True)
+ return Boolean
+ is
+ Code : Interfaces.C.int := fl_browser_select
+ (This.Void_Ptr,
+ Interfaces.C.int (Line),
+ Boolean'Pos (State));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ return Boolean'Val (Code);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Set_Select;
+
+
+ procedure Set_Select
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ State : in Boolean := True)
+ is
+ Code : Interfaces.C.int := fl_browser_select
+ (This.Void_Ptr,
+ Interfaces.C.int (Line),
+ Boolean'Pos (State));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Set_Select;
+
+
+ function Is_Selected
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean
+ is
+ Code : Interfaces.C.int := fl_browser_selected
+ (This.Void_Ptr,
+ Interfaces.C.int (Line));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ return Boolean'Val (Code);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Is_Selected;
+
+
+ function Selected_Index
+ (This : in Textline_Browser)
+ return Natural is
+ begin
+ return Natural (fl_browser_value (This.Void_Ptr));
+ end Selected_Index;
+
+
+
+
+ function Is_Visible
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean is
+ begin
+ return fl_browser_visible (This.Void_Ptr, Interfaces.C.int (Line)) /= 0;
+ end Is_Visible;
+
+
+ procedure Make_Visible
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_make_visible (This.Void_Ptr, Interfaces.C.int (Line));
+ end Make_Visible;
+
+
+ function Is_Displayed
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean
+ is
+ Code : Interfaces.C.int := fl_browser_displayed
+ (This.Void_Ptr,
+ Interfaces.C.int (Line));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ return Boolean'Val (Code);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Is_Displayed;
+
+
+ procedure Show_Line
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_show_line (This.Void_Ptr, Interfaces.C.int (Line));
+ end Show_Line;
+
+
+ procedure Hide_Line
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_hide_line (This.Void_Ptr, Interfaces.C.int (Line));
+ end Hide_Line;
+
+
+ procedure Show
+ (This : in out Textline_Browser) is
+ begin
+ fl_browser_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Hide
+ (This : in out Textline_Browser) is
+ begin
+ fl_browser_hide (This.Void_Ptr);
+ end Hide;
+
+
+
+
+ procedure Resize
+ (This : in out Textline_Browser;
+ W, H : in Integer) is
+ begin
+ fl_browser_set_size
+ (This.Void_Ptr,
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+
+
+ function Has_Icon
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean is
+ begin
+ return Line <= This.Icons.Last_Index and then This.Icons.Element (Line) /= null;
+ end Has_Icon;
+
+
+ function Get_Icon
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return FLTK.Images.Image_Reference is
+ begin
+ return Ref : FLTK.Images.Image_Reference (Data => This.Icons.Element (Line));
+ end Get_Icon;
+
+
+ procedure Set_Icon
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Icon : in FLTK.Images.Image'Class) is
+ begin
+ fl_browser_set_icon (This.Void_Ptr, Interfaces.C.int (Line), Wrapper (Icon).Void_Ptr);
+ if Line > This.Icons.Last_Index then
+ This.Icons.Append (null, Ada.Containers.Count_Type (Line - This.Icons.Last_Index - 1));
+ This.Icons.Append (new FLTK.Images.Image);
+ Wrapper (This.Icons.Element (Line).all).Needs_Dealloc := False;
+ elsif This.Icons.Element (Line) = null then
+ This.Icons.Replace_Element (Line, new FLTK.Images.Image);
+ Wrapper (This.Icons.Element (Line).all).Needs_Dealloc := False;
+ end if;
+ Wrapper (This.Icons.Element (Line).all).Void_Ptr := Wrapper (Icon).Void_Ptr;
+ end Set_Icon;
+
+
+ procedure Remove_Icon
+ (This : in out Textline_Browser;
+ Line : in Positive)
+ is
+ Ptr : Image_Access;
+ begin
+ fl_browser_remove_icon (This.Void_Ptr, Interfaces.C.int (Line));
+ if Line <= This.Icons.Last_Index then
+ Ptr := This.Icons.Element (Line);
+ Free (Ptr);
+ This.Icons.Replace_Element (Line, null);
+ end if;
+ end Remove_Icon;
+
+
+
+
+ function Full_List_Height
+ (This : in Textline_Browser)
+ return Integer is
+ begin
+ return Browser (This).Full_List_Height;
+ end Full_List_Height;
+
+
+ function Average_Item_Height
+ (This : in Textline_Browser)
+ return Integer is
+ begin
+ return Browser (This).Average_Item_Height;
+ end Average_Item_Height;
+
+
+
+
+ function Item_Width
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Integer
+ is
+ function my_item_width
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_item_width'Address use This.Item_Override_Ptrs (Item_Width_Ptr);
+ pragma Import (Ada, my_item_width);
+ begin
+ return Integer (my_item_width (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Item_Width;
+
+
+ function Item_Height
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Integer
+ is
+ function my_item_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_item_height'Address use This.Item_Override_Ptrs (Item_Height_Ptr);
+ pragma Import (Ada, my_item_height);
+ begin
+ return Integer (my_item_height (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Item_Height;
+
+
+ function Item_First
+ (This : in Textline_Browser)
+ return Item_Cursor
+ is
+ function my_item_first
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ for my_item_first'Address use This.Item_Override_Ptrs (Item_First_Ptr);
+ pragma Import (Ada, my_item_first);
+ begin
+ return Address_To_Cursor (my_item_first (This.Void_Ptr));
+ end Item_First;
+
+
+ function Item_Last
+ (This : in Textline_Browser)
+ return Item_Cursor
+ is
+ function my_item_last
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ for my_item_last'Address use This.Item_Override_Ptrs (Item_Last_Ptr);
+ pragma Import (Ada, my_item_last);
+ begin
+ return Address_To_Cursor (my_item_last (This.Void_Ptr));
+ end Item_Last;
+
+
+ function Item_Next
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor
+ is
+ function my_item_next
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ for my_item_next'Address use This.Item_Override_Ptrs (Item_Next_Ptr);
+ pragma Import (Ada, my_item_next);
+ begin
+ return Address_To_Cursor (my_item_next (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Item_Next;
+
+
+ function Item_Previous
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor
+ is
+ function my_item_prev
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ for my_item_prev'Address use This.Item_Override_Ptrs (Item_Previous_Ptr);
+ pragma Import (Ada, my_item_prev);
+ begin
+ return Address_To_Cursor (my_item_prev (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Item_Previous;
+
+
+ function Item_At
+ (This : in Textline_Browser;
+ Index : in Positive)
+ return Item_Cursor
+ is
+ function my_item_at
+ (B : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ for my_item_at'Address use This.Item_Override_Ptrs (Item_At_Ptr);
+ pragma Import (Ada, my_item_at);
+ begin
+ return Address_To_Cursor (my_item_at (This.Void_Ptr, Interfaces.C.int (Index)));
+ end Item_At;
+
+
+ procedure Item_Select
+ (This : in out Textline_Browser;
+ Item : in Item_Cursor;
+ State : in Boolean := True)
+ is
+ procedure my_item_select
+ (B, I : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ for my_item_select'Address use This.Item_Override_Ptrs (Item_Select_Ptr);
+ pragma Import (Ada, my_item_select);
+ begin
+ my_item_select (This.Void_Ptr, Cursor_To_Address (Item), Boolean'Pos (State));
+ end Item_Select;
+
+
+ function Item_Selected
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Boolean
+ is
+ function my_item_selected
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_item_selected'Address use This.Item_Override_Ptrs (Item_Selected_Ptr);
+ pragma Import (Ada, my_item_selected);
+ Code : Interfaces.C.int := my_item_selected (This.Void_Ptr, Cursor_To_Address (Item));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ return Boolean'Val (Code);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Item_Selected;
+
+
+ procedure Item_Swap
+ (This : in out Textline_Browser;
+ A, B : in Item_Cursor)
+ is
+ procedure my_item_swap
+ (B, X, Y : in Storage.Integer_Address);
+ for my_item_swap'Address use This.Item_Override_Ptrs (Item_Swap_Ptr);
+ pragma Import (Ada, my_item_swap);
+ begin
+ my_item_swap (This.Void_Ptr, Cursor_To_Address (A), Cursor_To_Address (B));
+ end Item_Swap;
+
+
+ function Item_Text
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return String
+ is
+ function my_item_text
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ for my_item_text'Address use This.Item_Override_Ptrs (Item_Text_Ptr);
+ pragma Import (Ada, my_item_text);
+ begin
+ return Interfaces.C.Strings.Value (my_item_text (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Item_Text;
+
+
+ procedure Item_Draw
+ (This : in Textline_Browser;
+ Item : in Item_Cursor;
+ X, Y, W, H : in Integer)
+ is
+ procedure my_item_draw
+ (B, I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ for my_item_draw'Address use This.Item_Override_Ptrs (Item_Draw_Ptr);
+ pragma Import (Ada, my_item_draw);
+ begin
+ my_item_draw
+ (This.Void_Ptr,
+ Cursor_To_Address (Item),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Item_Draw;
+
+
+
+
+ function Line_Number
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Natural is
+ begin
+ return Natural (fl_browser_lineno (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Line_Number;
+
+
+end FLTK.Widgets.Groups.Browsers.Textline;
+
+
diff --git a/body/fltk-widgets-groups-browsers.adb b/body/fltk-widgets-groups-browsers.adb
new file mode 100644
index 0000000..36b9f2f
--- /dev/null
+++ b/body/fltk-widgets-groups-browsers.adb
@@ -0,0 +1,1388 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C.Strings,
+ System.Address_To_Access_Conversions;
+
+
+package body FLTK.Widgets.Groups.Browsers is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Constants From C --
+ ------------------------
+
+ fl_sort_ascending : constant Interfaces.C.int;
+ pragma Import (C, fl_sort_ascending, "fl_sort_ascending");
+
+ fl_sort_descending : constant Interfaces.C.int;
+ pragma Import (C, fl_sort_descending, "fl_sort_descending");
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_abstract_browser
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_abstract_browser, "new_fl_abstract_browser");
+ pragma Inline (new_fl_abstract_browser);
+
+ procedure free_fl_abstract_browser
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_abstract_browser, "free_fl_abstract_browser");
+ pragma Inline (free_fl_abstract_browser);
+
+
+
+
+ function fl_abstract_browser_hscrollbar
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_abstract_browser_hscrollbar, "fl_abstract_browser_hscrollbar");
+ pragma Inline (fl_abstract_browser_hscrollbar);
+
+ function fl_abstract_browser_scrollbar
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_abstract_browser_scrollbar, "fl_abstract_browser_scrollbar");
+ pragma Inline (fl_abstract_browser_scrollbar);
+
+
+
+
+ function fl_abstract_browser_select
+ (B, I : in Storage.Integer_Address;
+ V, C : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_select, "fl_abstract_browser_select");
+ pragma Inline (fl_abstract_browser_select);
+
+ function fl_abstract_browser_select_only
+ (B, I : in Storage.Integer_Address;
+ C : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_select_only, "fl_abstract_browser_select_only");
+ pragma Inline (fl_abstract_browser_select_only);
+
+ function fl_abstract_browser_selection
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_abstract_browser_selection, "fl_abstract_browser_selection");
+ pragma Inline (fl_abstract_browser_selection);
+
+ function fl_abstract_browser_deselect
+ (B : in Storage.Integer_Address;
+ C : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_deselect, "fl_abstract_browser_deselect");
+ pragma Inline (fl_abstract_browser_deselect);
+
+ procedure fl_abstract_browser_display
+ (B, I : in Storage.Integer_Address);
+ pragma Import (C, fl_abstract_browser_display, "fl_abstract_browser_display");
+ pragma Inline (fl_abstract_browser_display);
+
+ function fl_abstract_browser_displayed
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_displayed, "fl_abstract_browser_displayed");
+ pragma Inline (fl_abstract_browser_displayed);
+
+ function fl_abstract_browser_find_item
+ (B : in Storage.Integer_Address;
+ Y : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_abstract_browser_find_item, "fl_abstract_browser_find_item");
+ pragma Inline (fl_abstract_browser_find_item);
+
+ function fl_abstract_browser_top
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_abstract_browser_top, "fl_abstract_browser_top");
+ pragma Inline (fl_abstract_browser_top);
+
+ procedure fl_abstract_browser_sort
+ (B : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_abstract_browser_sort, "fl_abstract_browser_sort");
+ pragma Inline (fl_abstract_browser_sort);
+
+
+
+
+ function fl_abstract_browser_get_has_scrollbar
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.unsigned_char;
+ pragma Import (C, fl_abstract_browser_get_has_scrollbar,
+ "fl_abstract_browser_get_has_scrollbar");
+ pragma Inline (fl_abstract_browser_get_has_scrollbar);
+
+ procedure fl_abstract_browser_set_has_scrollbar
+ (B : in Storage.Integer_Address;
+ M : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_abstract_browser_set_has_scrollbar,
+ "fl_abstract_browser_set_has_scrollbar");
+ pragma Inline (fl_abstract_browser_set_has_scrollbar);
+
+ function fl_abstract_browser_get_hposition
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_get_hposition, "fl_abstract_browser_get_hposition");
+ pragma Inline (fl_abstract_browser_get_hposition);
+
+ procedure fl_abstract_browser_set_hposition
+ (B : in Storage.Integer_Address;
+ P : in Interfaces.C.int);
+ pragma Import (C, fl_abstract_browser_set_hposition, "fl_abstract_browser_set_hposition");
+ pragma Inline (fl_abstract_browser_set_hposition);
+
+ function fl_abstract_browser_get_position
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_get_position, "fl_abstract_browser_get_position");
+ pragma Inline (fl_abstract_browser_get_position);
+
+ procedure fl_abstract_browser_set_position
+ (B : in Storage.Integer_Address;
+ P : in Interfaces.C.int);
+ pragma Import (C, fl_abstract_browser_set_position, "fl_abstract_browser_set_position");
+ pragma Inline (fl_abstract_browser_set_position);
+
+ procedure fl_abstract_browser_scrollbar_left
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_abstract_browser_scrollbar_left, "fl_abstract_browser_scrollbar_left");
+ pragma Inline (fl_abstract_browser_scrollbar_left);
+
+ procedure fl_abstract_browser_scrollbar_right
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_abstract_browser_scrollbar_right, "fl_abstract_browser_scrollbar_right");
+ pragma Inline (fl_abstract_browser_scrollbar_right);
+
+ function fl_abstract_browser_get_scrollbar_size
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_get_scrollbar_size,
+ "fl_abstract_browser_get_scrollbar_size");
+ pragma Inline (fl_abstract_browser_get_scrollbar_size);
+
+ procedure fl_abstract_browser_set_scrollbar_size
+ (B : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_abstract_browser_set_scrollbar_size,
+ "fl_abstract_browser_set_scrollbar_size");
+ pragma Inline (fl_abstract_browser_set_scrollbar_size);
+
+
+
+
+ function fl_abstract_browser_get_textcolor
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_abstract_browser_get_textcolor, "fl_abstract_browser_get_textcolor");
+ pragma Inline (fl_abstract_browser_get_textcolor);
+
+ procedure fl_abstract_browser_set_textcolor
+ (B : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_abstract_browser_set_textcolor, "fl_abstract_browser_set_textcolor");
+ pragma Inline (fl_abstract_browser_set_textcolor);
+
+ function fl_abstract_browser_get_textfont
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_get_textfont, "fl_abstract_browser_get_textfont");
+ pragma Inline (fl_abstract_browser_get_textfont);
+
+ procedure fl_abstract_browser_set_textfont
+ (B : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_abstract_browser_set_textfont, "fl_abstract_browser_set_textfont");
+ pragma Inline (fl_abstract_browser_set_textfont);
+
+ function fl_abstract_browser_get_textsize
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_get_textsize, "fl_abstract_browser_get_textsize");
+ pragma Inline (fl_abstract_browser_get_textsize);
+
+ procedure fl_abstract_browser_set_textsize
+ (B : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_abstract_browser_set_textsize, "fl_abstract_browser_set_textsize");
+ pragma Inline (fl_abstract_browser_set_textsize);
+
+
+
+
+ procedure fl_abstract_browser_resize
+ (B : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_abstract_browser_resize, "fl_abstract_browser_resize");
+ pragma Inline (fl_abstract_browser_resize);
+
+ procedure fl_abstract_browser_bbox
+ (B : in Storage.Integer_Address;
+ X, Y, W, H : out Interfaces.C.int);
+ pragma Import (C, fl_abstract_browser_bbox, "fl_abstract_browser_bbox");
+ pragma Inline (fl_abstract_browser_bbox);
+
+ function fl_abstract_browser_leftedge
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_leftedge, "fl_abstract_browser_leftedge");
+ pragma Inline (fl_abstract_browser_leftedge);
+
+ procedure fl_abstract_browser_redraw_line
+ (B, I : in Storage.Integer_Address);
+ pragma Import (C, fl_abstract_browser_redraw_line, "fl_abstract_browser_redraw_line");
+ pragma Inline (fl_abstract_browser_redraw_line);
+
+ procedure fl_abstract_browser_redraw_lines
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_abstract_browser_redraw_lines, "fl_abstract_browser_redraw_lines");
+ pragma Inline (fl_abstract_browser_redraw_lines);
+
+
+
+
+ function fl_abstract_browser_full_width
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_full_width, "fl_abstract_browser_full_width");
+ pragma Inline (fl_abstract_browser_full_width);
+
+ function fl_abstract_browser_full_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_full_height, "fl_abstract_browser_full_height");
+ pragma Inline (fl_abstract_browser_full_height);
+
+ function fl_abstract_browser_incr_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_incr_height, "fl_abstract_browser_incr_height");
+ pragma Inline (fl_abstract_browser_incr_height);
+
+ function fl_abstract_browser_item_quick_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_item_quick_height,
+ "fl_abstract_browser_item_quick_height");
+ pragma Inline (fl_abstract_browser_item_quick_height);
+
+
+
+
+ procedure fl_abstract_browser_new_list
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_abstract_browser_new_list, "fl_abstract_browser_new_list");
+ pragma Inline (fl_abstract_browser_new_list);
+
+ procedure fl_abstract_browser_inserting
+ (B, A1, A2 : in Storage.Integer_Address);
+ pragma Import (C, fl_abstract_browser_inserting, "fl_abstract_browser_inserting");
+ pragma Inline (fl_abstract_browser_inserting);
+
+ procedure fl_abstract_browser_deleting
+ (B, I : in Storage.Integer_Address);
+ pragma Import (C, fl_abstract_browser_deleting, "fl_abstract_browser_deleting");
+ pragma Inline (fl_abstract_browser_deleting);
+
+ procedure fl_abstract_browser_replacing
+ (B, A1, A2 : in Storage.Integer_Address);
+ pragma Import (C, fl_abstract_browser_replacing, "fl_abstract_browser_replacing");
+ pragma Inline (fl_abstract_browser_replacing);
+
+ procedure fl_abstract_browser_swapping
+ (B, A1, A2 : in Storage.Integer_Address);
+ pragma Import (C, fl_abstract_browser_swapping, "fl_abstract_browser_swapping");
+ pragma Inline (fl_abstract_browser_swapping);
+
+
+
+
+ procedure fl_abstract_browser_draw
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_abstract_browser_draw, "fl_abstract_browser_draw");
+ pragma Inline (fl_abstract_browser_draw);
+
+ function fl_abstract_browser_handle
+ (B : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abstract_browser_handle, "fl_abstract_browser_handle");
+ pragma Inline (fl_abstract_browser_handle);
+
+
+
+
+ ----------------------
+ -- Exported Hooks --
+ ----------------------
+
+ package Browser_Convert is new System.Address_To_Access_Conversions (Browser'Class);
+
+
+ function Full_Width_Hook
+ (Ada_Addr : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Export (C, Full_Width_Hook, "browser_full_width_hook");
+
+ function Full_Width_Hook
+ (Ada_Addr : in Storage.Integer_Address)
+ return Interfaces.C.int
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ return Interfaces.C.int (Ada_Object.Full_List_Width);
+ end Full_Width_Hook;
+
+
+ function Full_Height_Hook
+ (Ada_Addr : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Export (C, Full_Height_Hook, "browser_full_height_hook");
+
+ function Full_Height_Hook
+ (Ada_Addr : in Storage.Integer_Address)
+ return Interfaces.C.int
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ return Interfaces.C.int (Ada_Object.Full_List_Height);
+ end Full_Height_Hook;
+
+
+ function Average_Item_Height_Hook
+ (Ada_Addr : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Export (C, Average_Item_Height_Hook, "browser_incr_height_hook");
+
+ function Average_Item_Height_Hook
+ (Ada_Addr : in Storage.Integer_Address)
+ return Interfaces.C.int
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ return Interfaces.C.int (Ada_Object.Average_Item_Height);
+ end Average_Item_Height_Hook;
+
+
+ function Item_Quick_Height_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Export (C, Item_Quick_Height_Hook, "browser_item_quick_height_hook");
+
+ function Item_Quick_Height_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Interfaces.C.int
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ return Interfaces.C.int (Ada_Object.Item_Quick_Height (Address_To_Cursor (Item_Ptr)));
+ end Item_Quick_Height_Hook;
+
+
+ function Item_Width_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Export (C, Item_Width_Hook, "browser_item_width_hook");
+
+ function Item_Width_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Interfaces.C.int
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ return Interfaces.C.int (Ada_Object.Item_Width (Address_To_Cursor (Item_Ptr)));
+ end Item_Width_Hook;
+
+
+ function Item_Height_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Export (C, Item_Height_Hook, "browser_item_height_hook");
+
+ function Item_Height_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Interfaces.C.int
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ return Interfaces.C.int (Ada_Object.Item_Height (Address_To_Cursor (Item_Ptr)));
+ end Item_Height_Hook;
+
+
+ function Item_First_Hook
+ (Ada_Addr : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Export (C, Item_First_Hook, "browser_item_first_hook");
+
+ function Item_First_Hook
+ (Ada_Addr : in Storage.Integer_Address)
+ return Storage.Integer_Address
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ return Cursor_To_Address (Ada_Object.Item_First);
+ end Item_First_Hook;
+
+
+ function Item_Last_Hook
+ (Ada_Addr : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Export (C, Item_Last_Hook, "browser_item_last_hook");
+
+ function Item_Last_Hook
+ (Ada_Addr : in Storage.Integer_Address)
+ return Storage.Integer_Address
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ return Cursor_To_Address (Ada_Object.Item_Last);
+ end Item_Last_Hook;
+
+
+ function Item_Next_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Export (C, Item_Next_Hook, "browser_item_next_hook");
+
+ function Item_Next_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Storage.Integer_Address
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ return Cursor_To_Address (Ada_Object.Item_Next (Address_To_Cursor (Item_Ptr)));
+ end Item_Next_Hook;
+
+
+ function Item_Previous_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Export (C, Item_Previous_Hook, "browser_item_prev_hook");
+
+ function Item_Previous_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Storage.Integer_Address
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ return Cursor_To_Address (Ada_Object.Item_Previous (Address_To_Cursor (Item_Ptr)));
+ end Item_Previous_Hook;
+
+
+ function Item_At_Hook
+ (Ada_Addr : in Storage.Integer_Address;
+ Index : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Export (C, Item_At_Hook, "browser_item_at_hook");
+
+ function Item_At_Hook
+ (Ada_Addr : in Storage.Integer_Address;
+ Index : in Interfaces.C.int)
+ return Storage.Integer_Address
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ use type Interfaces.C.int;
+ begin
+ return Cursor_To_Address (Ada_Object.Item_At (Positive (Index + 1)));
+ end Item_At_Hook;
+
+
+ procedure Item_Select_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address;
+ Int_State : in Interfaces.C.int);
+ pragma Export (C, Item_Select_Hook, "browser_item_select_hook");
+
+ procedure Item_Select_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address;
+ Int_State : in Interfaces.C.int)
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ use type Interfaces.C.int;
+ begin
+ Ada_Object.Item_Select
+ (Address_To_Cursor (Item_Ptr),
+ Int_State /= 0);
+ end Item_Select_Hook;
+
+
+ function Item_Selected_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Export (C, Item_Selected_Hook, "browser_item_selected_hook");
+
+ function Item_Selected_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Interfaces.C.int
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ return Boolean'Pos (Ada_Object.Item_Selected (Address_To_Cursor (Item_Ptr)));
+ end Item_Selected_Hook;
+
+
+ procedure Item_Swap_Hook
+ (Ada_Addr, A_Ptr, B_Ptr : in Storage.Integer_Address);
+ pragma Export (C, Item_Swap_Hook, "browser_item_swap_hook");
+
+ procedure Item_Swap_Hook
+ (Ada_Addr, A_Ptr, B_Ptr : in Storage.Integer_Address)
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ Ada_Object.Item_Swap (Address_To_Cursor (A_Ptr), Address_To_Cursor (B_Ptr));
+ end Item_Swap_Hook;
+
+
+ -- The following is a hack due to inherent incompatibilities between Ada Strings
+ -- and C char pointers. The hook will convert Strings to char* and return them
+ -- fine for the first two calls, but after that it will deallocate the oldest
+ -- char* it previously returned to make room for more. Fortunately, this hook
+ -- is only used by the FLTK C++ side of things for comparing two strings for the
+ -- purposes of sorting items so it all works out in the end.
+
+ -- Calls by the Ada programmer to Item_Text will be completely unaffected, but
+ -- this does mean that the default implementation of Sort is not task safe.
+
+ -- At the time of writing this I have no idea how task safe FLTK is anyway.
+
+ function Item_Text_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Export (C, Item_Text_Hook, "browser_item_text_hook");
+
+ function Item_Text_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ Interfaces.C.Strings.Free (Ada_Object.Text_Store (Ada_Object.Current));
+ Ada_Object.Text_Store (Ada_Object.Current) := Interfaces.C.Strings.New_String
+ (Ada_Object.Item_Text (Address_To_Cursor (Item_Ptr)));
+ return C_Char_Is_Not_A_String : Interfaces.C.Strings.chars_ptr :=
+ Ada_Object.Text_Store (Ada_Object.Current)
+ do
+ Ada_Object.Current := Ada_Object.Current + 1;
+ if Ada_Object.Current > Ada_Object.Text_Store'Last then
+ Ada_Object.Current := Ada_Object.Text_Store'First;
+ end if;
+ end return;
+ end Item_Text_Hook;
+
+
+ procedure Item_Draw_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Export (C, Item_Draw_Hook, "browser_item_draw_hook");
+
+ procedure Item_Draw_Hook
+ (Ada_Addr, Item_Ptr : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int)
+ is
+ Ada_Object : access Browser'Class :=
+ Browser_Convert.To_Pointer (Storage.To_Address (Ada_Addr));
+ begin
+ Ada_Object.Item_Draw
+ (Address_To_Cursor (Item_Ptr),
+ Integer (X),
+ Integer (Y),
+ Integer (W),
+ Integer (H));
+ end Item_Draw_Hook;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ -- Preparing to use morse code
+ procedure fl_scrollbar_extra_final
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Import (C, fl_scrollbar_extra_final, "fl_scrollbar_extra_final");
+ pragma Inline (fl_scrollbar_extra_final);
+
+
+ procedure Extra_Final
+ (This : in out Browser) is
+ begin
+ fl_scrollbar_extra_final (Storage.To_Integer (This.Horizon'Address));
+ fl_scrollbar_extra_final (Storage.To_Integer (This.Vertigo'Address));
+ Extra_Final (Group (This));
+ for Index in This.Text_Store'Range loop
+ Interfaces.C.Strings.Free (This.Text_Store (Index));
+ end loop;
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Browser) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_abstract_browser (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ -- Boarding the Titanic...
+ procedure fl_scrollbar_extra_init
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.char_array);
+ pragma Import (C, fl_scrollbar_extra_init, "fl_scrollbar_extra_init");
+ pragma Inline (fl_scrollbar_extra_init);
+
+
+ procedure Extra_Init
+ (This : in out Browser;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Widget (This.Horizon).Void_Ptr := fl_abstract_browser_hscrollbar (This.Void_Ptr);
+ Widget (This.Horizon).Needs_Dealloc := False;
+ fl_scrollbar_extra_init
+ (Storage.To_Integer (This.Horizon'Address),
+ Interfaces.C.int (This.Horizon.Get_X),
+ Interfaces.C.int (This.Horizon.Get_Y),
+ Interfaces.C.int (This.Horizon.Get_W),
+ Interfaces.C.int (This.Horizon.Get_H),
+ Interfaces.C.To_C (This.Horizon.Get_Label));
+ Widget (This.Vertigo).Void_Ptr := fl_abstract_browser_scrollbar (This.Void_Ptr);
+ Widget (This.Vertigo).Needs_Dealloc := False;
+ fl_scrollbar_extra_init
+ (Storage.To_Integer (This.Vertigo'Address),
+ Interfaces.C.int (This.Vertigo.Get_X),
+ Interfaces.C.int (This.Vertigo.Get_Y),
+ Interfaces.C.int (This.Vertigo.Get_W),
+ Interfaces.C.int (This.Vertigo.Get_H),
+ Interfaces.C.To_C (This.Vertigo.Get_Label));
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Browser) is
+ begin
+ This.Wide_High_Ptrs :=
+ (Full_List_Width_Ptr => fl_abstract_browser_full_width'Address,
+ Full_List_Height_Ptr => fl_abstract_browser_full_height'Address,
+ Average_Item_Height_Ptr => fl_abstract_browser_incr_height'Address,
+ Item_Quick_Height_Ptr => fl_abstract_browser_item_quick_height'Address);
+ This.Draw_Ptr := fl_abstract_browser_draw'Address;
+ This.Handle_Ptr := fl_abstract_browser_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Browser is
+ begin
+ return This : Browser do
+ This.Void_Ptr := new_fl_abstract_browser
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Browser is
+ begin
+ return This : Browser := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ -- Access to the Browser's self contained scrollbars
+
+ function H_Bar
+ (This : in out Browser)
+ return Valuators.Sliders.Scrollbars.Scrollbar_Reference is
+ begin
+ return (Data => This.Horizon'Unchecked_Access);
+ end H_Bar;
+
+
+ function V_Bar
+ (This : in out Browser)
+ return Valuators.Sliders.Scrollbars.Scrollbar_Reference is
+ begin
+ return (Data => This.Vertigo'Unchecked_Access);
+ end V_Bar;
+
+
+
+
+ -- Item related settings
+
+ function Set_Select
+ (This : in out Browser;
+ Item : in Item_Cursor;
+ State : in Boolean := True;
+ Do_Callbacks : in Boolean := False)
+ return Boolean
+ is
+ Code : Interfaces.C.int := fl_abstract_browser_select
+ (This.Void_Ptr,
+ Cursor_To_Address (Item),
+ Boolean'Pos (State),
+ Boolean'Pos (Do_Callbacks));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ return Boolean'Val (Code);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Set_Select;
+
+
+ procedure Set_Select
+ (This : in out Browser;
+ Item : in Item_Cursor;
+ State : in Boolean := True;
+ Do_Callbacks : in Boolean := False)
+ is
+ Code : Interfaces.C.int := fl_abstract_browser_select
+ (This.Void_Ptr,
+ Cursor_To_Address (Item),
+ Boolean'Pos (State),
+ Boolean'Pos (Do_Callbacks));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Set_Select;
+
+
+ function Select_Only
+ (This : in out Browser;
+ Item : in Item_Cursor;
+ Do_Callbacks : in Boolean := False)
+ return Boolean
+ is
+ Code : Interfaces.C.int := fl_abstract_browser_select_only
+ (This.Void_Ptr,
+ Cursor_To_Address (Item),
+ Boolean'Pos (Do_Callbacks));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ return Boolean'Val (Code);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Select_Only;
+
+
+ procedure Select_Only
+ (This : in out Browser;
+ Item : in Item_Cursor;
+ Do_Callbacks : in Boolean := False)
+ is
+ Code : Interfaces.C.int := fl_abstract_browser_select_only
+ (This.Void_Ptr,
+ Cursor_To_Address (Item),
+ Boolean'Pos (Do_Callbacks));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Select_Only;
+
+
+ function Current_Selection
+ (This : in Browser)
+ return Item_Cursor is
+ begin
+ return Address_To_Cursor (fl_abstract_browser_selection (This.Void_Ptr));
+ end Current_Selection;
+
+
+ function Deselect
+ (This : in out Browser;
+ Do_Callbacks : in Boolean := False)
+ return Boolean
+ is
+ Code : Interfaces.C.int := fl_abstract_browser_deselect
+ (This.Void_Ptr,
+ Boolean'Pos (Do_Callbacks));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ return Boolean'Val (Code);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Deselect;
+
+
+ procedure Deselect
+ (This : in out Browser;
+ Do_Callbacks : in Boolean := False)
+ is
+ Code : Interfaces.C.int := fl_abstract_browser_deselect
+ (This.Void_Ptr,
+ Boolean'Pos (Do_Callbacks));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Deselect;
+
+
+ procedure Display
+ (This : in out Browser;
+ Item : in Item_Cursor) is
+ begin
+ fl_abstract_browser_display (This.Void_Ptr, Cursor_To_Address (Item));
+ end Display;
+
+
+ function Is_Displayed
+ (This : in Browser;
+ Item : in Item_Cursor)
+ return Boolean
+ is
+ Code : Interfaces.C.int := fl_abstract_browser_displayed
+ (This.Void_Ptr, Cursor_To_Address (Item));
+ begin
+ pragma Assert (Code in 0 .. 1);
+ return Boolean'Val (Code);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Is_Displayed;
+
+
+ function Find_Item
+ (This : in Browser;
+ Y_Pos : in Integer)
+ return Item_Cursor is
+ begin
+ return Address_To_Cursor (fl_abstract_browser_find_item
+ (This.Void_Ptr,
+ Interfaces.C.int (Y_Pos)));
+ end Find_Item;
+
+
+ function Top_Item
+ (This : in Browser)
+ return Item_Cursor is
+ begin
+ return Address_To_Cursor (fl_abstract_browser_top (This.Void_Ptr));
+ end Top_Item;
+
+
+ procedure Sort
+ (This : in out Browser;
+ Order : in Sort_Order)
+ is
+ Code : Interfaces.C.int :=
+ (case Order is
+ when Ascending => fl_sort_ascending,
+ when Descending => fl_sort_descending);
+ begin
+ fl_abstract_browser_sort (This.Void_Ptr, Code);
+ end Sort;
+
+
+
+
+ -- Scrollbar related settings
+
+ function Get_Scrollbar_Mode
+ (This : in Browser)
+ return Scrollbar_Mode is
+ begin
+ return Uchar_To_Mode (fl_abstract_browser_get_has_scrollbar (This.Void_Ptr));
+ end Get_Scrollbar_Mode;
+
+
+ procedure Set_Scrollbar_Mode
+ (This : in out Browser;
+ Mode : in Scrollbar_Mode) is
+ begin
+ fl_abstract_browser_set_has_scrollbar (This.Void_Ptr, Mode_To_Uchar (Mode));
+ end Set_Scrollbar_Mode;
+
+
+ function Get_H_Position
+ (This : in Browser)
+ return Integer is
+ begin
+ return Integer (fl_abstract_browser_get_hposition (This.Void_Ptr));
+ end Get_H_Position;
+
+
+ procedure Set_H_Position
+ (This : in out Browser;
+ Value : in Integer) is
+ begin
+ fl_abstract_browser_set_hposition
+ (This.Void_Ptr,
+ Interfaces.C.int (Value));
+ end Set_H_Position;
+
+
+ function Get_V_Position
+ (This : in Browser)
+ return Integer is
+ begin
+ return Integer (fl_abstract_browser_get_position (This.Void_Ptr));
+ end Get_V_Position;
+
+
+ procedure Set_V_Position
+ (This : in out Browser;
+ Value : in Integer) is
+ begin
+ fl_abstract_browser_set_position
+ (This.Void_Ptr,
+ Interfaces.C.int (Value));
+ end Set_V_Position;
+
+
+ procedure Set_Vertical_Left
+ (This : in out Browser) is
+ begin
+ fl_abstract_browser_scrollbar_left (This.Void_Ptr);
+ end Set_Vertical_Left;
+
+
+ procedure Set_Vertical_Right
+ (This : in out Browser) is
+ begin
+ fl_abstract_browser_scrollbar_right (This.Void_Ptr);
+ end Set_Vertical_Right;
+
+
+ function Get_Scrollbar_Size
+ (This : in Browser)
+ return Integer is
+ begin
+ return Integer (fl_abstract_browser_get_scrollbar_size (This.Void_Ptr));
+ end Get_Scrollbar_Size;
+
+
+ procedure Set_Scrollbar_Size
+ (This : in out Browser;
+ Value : in Integer) is
+ begin
+ fl_abstract_browser_set_scrollbar_size
+ (This.Void_Ptr,
+ Interfaces.C.int (Value));
+ end Set_Scrollbar_Size;
+
+
+
+
+ -- Text related settings
+
+ function Get_Text_Color
+ (This : in Browser)
+ return Color is
+ begin
+ return Color (fl_abstract_browser_get_textcolor (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Browser;
+ Value : in Color) is
+ begin
+ fl_abstract_browser_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (Value));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Browser)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_abstract_browser_get_textfont (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Browser;
+ Font : in Font_Kind) is
+ begin
+ fl_abstract_browser_set_textfont (This.Void_Ptr, Font_Kind'Pos (Font));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Browser)
+ return Font_Size is
+ begin
+ return Font_Size (fl_abstract_browser_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Browser;
+ Size : in Font_Size) is
+ begin
+ fl_abstract_browser_set_textsize (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Text_Size;
+
+
+
+
+ -- Graphical dimensions and redrawing
+
+ procedure Resize
+ (This : in out Browser;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_abstract_browser_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+ procedure Bounding_Box
+ (This : in Browser;
+ X, Y, W, H : out Integer) is
+ begin
+ fl_abstract_browser_bbox
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Bounding_Box;
+
+
+ function Left_Edge
+ (This : in Browser)
+ return Integer is
+ begin
+ return Integer (fl_abstract_browser_leftedge (This.Void_Ptr));
+ end Left_Edge;
+
+
+ procedure Redraw_Line
+ (This : in out Browser;
+ Item : in Item_Cursor) is
+ begin
+ fl_abstract_browser_redraw_line (This.Void_Ptr, Cursor_To_Address (Item));
+ end Redraw_Line;
+
+
+ procedure Redraw_List
+ (This : in out Browser) is
+ begin
+ fl_abstract_browser_redraw_lines (This.Void_Ptr);
+ end Redraw_List;
+
+
+
+
+ -- Optional Override API
+
+ function Full_List_Width
+ (This : in Browser)
+ return Integer
+ is
+ function my_full_width
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_full_width'Address use This.Wide_High_Ptrs (Full_List_Width_Ptr);
+ pragma Import (Ada, my_full_width);
+ begin
+ return Integer (my_full_width (This.Void_Ptr));
+ end Full_List_Width;
+
+
+ function Full_List_Height
+ (This : in Browser)
+ return Integer
+ is
+ function my_full_height
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_full_height'Address use This.Wide_High_Ptrs (Full_List_Height_Ptr);
+ pragma Import (Ada, my_full_height);
+ begin
+ return Integer (my_full_height (This.Void_Ptr));
+ end Full_List_Height;
+
+
+ function Average_Item_Height
+ (This : in Browser)
+ return Integer
+ is
+ function my_incr_height
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_incr_height'Address use This.Wide_High_Ptrs (Average_Item_Height_Ptr);
+ pragma Import (Ada, my_incr_height);
+ begin
+ return Integer (my_incr_height (This.Void_Ptr));
+ end Average_Item_Height;
+
+
+ function Item_Quick_Height
+ (This : in Browser;
+ Item : in Item_Cursor)
+ return Integer
+ is
+ function my_item_quick_height
+ (V, I : Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_item_quick_height'Address use This.Wide_High_Ptrs (Item_Quick_Height_Ptr);
+ pragma Import (Ada, my_item_quick_height);
+ begin
+ return Integer (my_item_quick_height
+ (This.Void_Ptr,
+ Cursor_To_Address (Item)));
+ end Item_Quick_Height;
+
+
+
+
+ -- Mandatory Override API
+
+ function Item_Width
+ (This : in Browser;
+ Item : in Item_Cursor)
+ return Integer is
+ begin
+ return raise Program_Error with "Browser Item_Width must be overridden";
+ end Item_Width;
+
+ function Item_Height
+ (This : in Browser;
+ Item : in Item_Cursor)
+ return Integer is
+ begin
+ return raise Program_Error with "Browser Item_Height must be overridden";
+ end Item_Height;
+
+ function Item_First
+ (This : in Browser)
+ return Item_Cursor is
+ begin
+ return raise Program_Error with "Browser Item_First must be overridden";
+ end Item_First;
+
+ function Item_Last
+ (This : in Browser)
+ return Item_Cursor is
+ begin
+ return raise Program_Error with "Browser Item_Last must be overridden";
+ end Item_Last;
+
+ function Item_Next
+ (This : in Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor is
+ begin
+ return raise Program_Error with "Browser Item_Next must be overridden";
+ end Item_Next;
+
+ function Item_Previous
+ (This : in Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor is
+ begin
+ return raise Program_Error with "Browser Item_Previous must be overridden";
+ end Item_Previous;
+
+ function Item_At
+ (This : in Browser;
+ Index : in Positive)
+ return Item_Cursor is
+ begin
+ return raise Program_Error with "Browser Item_At must be overridden";
+ end Item_At;
+
+ procedure Item_Select
+ (This : in out Browser;
+ Item : in Item_Cursor;
+ State : in Boolean := True) is
+ begin
+ raise Program_Error with "Browser Item_Select must be overridden";
+ end Item_Select;
+
+ function Item_Selected
+ (This : in Browser;
+ Item : in Item_Cursor)
+ return Boolean is
+ begin
+ return raise Program_Error with "Browser Item_Selected must be overridden";
+ end Item_Selected;
+
+ procedure Item_Swap
+ (This : in out Browser;
+ A, B : in Item_Cursor) is
+ begin
+ raise Program_Error with "Browser Item_Swap must be overridden";
+ end Item_Swap;
+
+ function Item_Text
+ (This : in Browser;
+ Item : in Item_Cursor)
+ return String is
+ begin
+ return raise Program_Error with "Browser Item_Text must be overridden";
+ end Item_Text;
+
+ procedure Item_Draw
+ (This : in Browser;
+ Item : in Item_Cursor;
+ X, Y, W, H : in Integer) is
+ begin
+ raise Program_Error with "Browser Item_Draw must be overridden";
+ end Item_Draw;
+
+
+
+
+ -- Cache invalidation
+
+ procedure New_List
+ (This : in out Browser) is
+ begin
+ fl_abstract_browser_new_list (This.Void_Ptr);
+ end New_List;
+
+
+ procedure Inserting
+ (This : in out Browser;
+ A, B : in Item_Cursor) is
+ begin
+ fl_abstract_browser_inserting
+ (This.Void_Ptr,
+ Cursor_To_Address (A),
+ Cursor_To_Address (B));
+ end Inserting;
+
+
+ procedure Deleting
+ (This : in out Browser;
+ Item : in Item_Cursor) is
+ begin
+ fl_abstract_browser_deleting
+ (This.Void_Ptr,
+ Cursor_To_Address (Item));
+ end Deleting;
+
+
+ procedure Replacing
+ (This : in out Browser;
+ A, B : in Item_Cursor) is
+ begin
+ fl_abstract_browser_replacing
+ (This.Void_Ptr,
+ Cursor_To_Address (A),
+ Cursor_To_Address (B));
+ end Replacing;
+
+
+ procedure Swapping
+ (This : in out Browser;
+ A, B : in Item_Cursor) is
+ begin
+ fl_abstract_browser_swapping
+ (This.Void_Ptr,
+ Cursor_To_Address (A),
+ Cursor_To_Address (B));
+ end Swapping;
+
+
+
+
+ -- Standard Override API
+
+ procedure Draw
+ (This : in out Browser)
+ is
+ procedure my_draw
+ (V : in Storage.Integer_Address);
+ for my_draw'Address use This.Draw_Ptr;
+ pragma Import (Ada, my_draw);
+ begin
+ my_draw (This.Void_Ptr);
+ end Draw;
+
+
+ function Handle
+ (This : in out Browser;
+ Event : in Event_Kind)
+ return Event_Outcome
+ is
+ function my_handle
+ (V : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ for my_handle'Address use This.Handle_Ptr;
+ pragma Import (Ada, my_handle);
+ begin
+ return Event_Outcome'Val (my_handle (This.Void_Ptr, Event_Kind'Pos (Event)));
+ end Handle;
+
+
+end FLTK.Widgets.Groups.Browsers;
+
+
diff --git a/body/fltk-widgets-groups-color_choosers.adb b/body/fltk-widgets-groups-color_choosers.adb
new file mode 100644
index 0000000..15f34ed
--- /dev/null
+++ b/body/fltk-widgets-groups-color_choosers.adb
@@ -0,0 +1,395 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Groups.Color_Choosers is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_color_chooser
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_color_chooser, "new_fl_color_chooser");
+ pragma Inline (new_fl_color_chooser);
+
+ procedure free_fl_color_chooser
+ (W : in Storage.Integer_Address);
+ pragma Import (C, free_fl_color_chooser, "free_fl_color_chooser");
+ pragma Inline (free_fl_color_chooser);
+
+
+
+
+ function fl_color_chooser_r
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_color_chooser_r, "fl_color_chooser_r");
+ pragma Inline (fl_color_chooser_r);
+
+ function fl_color_chooser_g
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_color_chooser_g, "fl_color_chooser_g");
+ pragma Inline (fl_color_chooser_g);
+
+ function fl_color_chooser_b
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_color_chooser_b, "fl_color_chooser_b");
+ pragma Inline (fl_color_chooser_b);
+
+ function fl_color_chooser_rgb
+ (N : in Storage.Integer_Address;
+ R, G, B : in Interfaces.C.double)
+ return Interfaces.C.int;
+ pragma Import (C, fl_color_chooser_rgb, "fl_color_chooser_rgb");
+ pragma Inline (fl_color_chooser_rgb);
+
+
+
+
+ function fl_color_chooser_hue
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_color_chooser_hue, "fl_color_chooser_hue");
+ pragma Inline (fl_color_chooser_hue);
+
+ function fl_color_chooser_saturation
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_color_chooser_saturation, "fl_color_chooser_saturation");
+ pragma Inline (fl_color_chooser_saturation);
+
+ function fl_color_chooser_value
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_color_chooser_value, "fl_color_chooser_value");
+ pragma Inline (fl_color_chooser_value);
+
+ function fl_color_chooser_hsv
+ (N : in Storage.Integer_Address;
+ H, S, V : in Interfaces.C.double)
+ return Interfaces.C.int;
+ pragma Import (C, fl_color_chooser_hsv, "fl_color_chooser_hsv");
+ pragma Inline (fl_color_chooser_hsv);
+
+
+
+
+ procedure fl_color_chooser_hsv2rgb
+ (H, S, V : in Interfaces.C.double;
+ R, G, B : out Interfaces.C.double);
+ pragma Import (C, fl_color_chooser_hsv2rgb, "fl_color_chooser_hsv2rgb");
+ pragma Inline (fl_color_chooser_hsv2rgb);
+
+ procedure fl_color_chooser_rgb2hsv
+ (R, G, B : in Interfaces.C.double;
+ H, S, V : out Interfaces.C.double);
+ pragma Import (C, fl_color_chooser_rgb2hsv, "fl_color_chooser_rgb2hsv");
+ pragma Inline (fl_color_chooser_rgb2hsv);
+
+
+
+
+ function fl_color_chooser_get_mode
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_color_chooser_get_mode, "fl_color_chooser_get_mode");
+ pragma Inline (fl_color_chooser_get_mode);
+
+ procedure fl_color_chooser_set_mode
+ (N : in Storage.Integer_Address;
+ M : in Interfaces.C.int);
+ pragma Import (C, fl_color_chooser_set_mode, "fl_color_chooser_set_mode");
+ pragma Inline (fl_color_chooser_set_mode);
+
+
+
+
+ procedure fl_color_chooser_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_color_chooser_draw, "fl_color_chooser_draw");
+ pragma Inline (fl_color_chooser_draw);
+
+ function fl_color_chooser_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_color_chooser_handle, "fl_color_chooser_handle");
+ pragma Inline (fl_color_chooser_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Color_Chooser) is
+ begin
+ Extra_Final (Group (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Color_Chooser) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_color_chooser (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Color_Chooser;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Color_Chooser) is
+ begin
+ This.Draw_Ptr := fl_color_chooser_draw'Address;
+ This.Handle_Ptr := fl_color_chooser_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Color_Chooser is
+ begin
+ return This : Color_Chooser do
+ This.Void_Ptr := new_fl_color_chooser
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Color_Chooser is
+ begin
+ return This : Color_Chooser := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Red
+ (This : in Color_Chooser)
+ return Long_Float is
+ begin
+ return Long_Float (fl_color_chooser_r (This.Void_Ptr));
+ end Get_Red;
+
+
+ function Get_Green
+ (This : in Color_Chooser)
+ return Long_Float is
+ begin
+ return Long_Float (fl_color_chooser_g (This.Void_Ptr));
+ end Get_Green;
+
+
+ function Get_Blue
+ (This : in Color_Chooser)
+ return Long_Float is
+ begin
+ return Long_Float (fl_color_chooser_b (This.Void_Ptr));
+ end Get_Blue;
+
+
+ procedure Set_RGB
+ (This : in out Color_Chooser;
+ R, G, B : in Long_Float)
+ is
+ Result : Interfaces.C.int := fl_color_chooser_rgb
+ (This.Void_Ptr,
+ Interfaces.C.double (R),
+ Interfaces.C.double (G),
+ Interfaces.C.double (B));
+ begin
+ pragma Assert (Result in 0 .. 1);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Set_RGB;
+
+
+ function Set_RGB
+ (This : in out Color_Chooser;
+ R, G, B : in Long_Float)
+ return Boolean
+ is
+ Result : Interfaces.C.int := fl_color_chooser_rgb
+ (This.Void_Ptr,
+ Interfaces.C.double (R),
+ Interfaces.C.double (G),
+ Interfaces.C.double (B));
+ begin
+ return Boolean'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error;
+ end Set_RGB;
+
+
+
+
+ function Get_Hue
+ (This : in Color_Chooser)
+ return Long_Float is
+ begin
+ return Long_Float (fl_color_chooser_hue (This.Void_Ptr));
+ end Get_Hue;
+
+
+ function Get_Saturation
+ (This : in Color_Chooser)
+ return Long_Float is
+ begin
+ return Long_Float (fl_color_chooser_saturation (This.Void_Ptr));
+ end Get_Saturation;
+
+
+ function Get_Value
+ (This : in Color_Chooser)
+ return Long_Float is
+ begin
+ return Long_Float (fl_color_chooser_value (This.Void_Ptr));
+ end Get_Value;
+
+
+ procedure Set_HSV
+ (This : in out Color_Chooser;
+ H, S, V : in Long_Float)
+ is
+ Result : Interfaces.C.int := fl_color_chooser_hsv
+ (This.Void_Ptr,
+ Interfaces.C.double (H),
+ Interfaces.C.double (S),
+ Interfaces.C.double (V));
+ begin
+ pragma Assert (Result in 0 .. 1);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Set_HSV;
+
+
+ function Set_HSV
+ (This : in out Color_Chooser;
+ H, S, V : in Long_Float)
+ return Boolean
+ is
+ Result : Interfaces.C.int := fl_color_chooser_hsv
+ (This.Void_Ptr,
+ Interfaces.C.double (H),
+ Interfaces.C.double (S),
+ Interfaces.C.double (V));
+ begin
+ return Boolean'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error;
+ end Set_HSV;
+
+
+
+
+ procedure HSV_To_RGB
+ (H, S, V : in Long_Float;
+ R, G, B : out Long_Float) is
+ begin
+ fl_color_chooser_hsv2rgb
+ (Interfaces.C.double (H),
+ Interfaces.C.double (S),
+ Interfaces.C.double (V),
+ Interfaces.C.double (R),
+ Interfaces.C.double (G),
+ Interfaces.C.double (B));
+ end HSV_To_RGB;
+
+
+ procedure RGB_To_HSV
+ (R, G, B : in Long_Float;
+ H, S, V : out Long_Float) is
+ begin
+ fl_color_chooser_rgb2hsv
+ (Interfaces.C.double (R),
+ Interfaces.C.double (G),
+ Interfaces.C.double (B),
+ Interfaces.C.double (H),
+ Interfaces.C.double (S),
+ Interfaces.C.double (V));
+ end RGB_To_HSV;
+
+
+
+
+ function Get_Mode
+ (This : in Color_Chooser)
+ return Color_Mode is
+ begin
+ return Color_Mode'Val (fl_color_chooser_get_mode (This.Void_Ptr));
+ end Get_Mode;
+
+
+ procedure Set_Mode
+ (This : in out Color_Chooser;
+ To : in Color_Mode) is
+ begin
+ fl_color_chooser_set_mode (This.Void_Ptr, Color_Mode'Pos (To));
+ end Set_Mode;
+
+
+end FLTK.Widgets.Groups.Color_Choosers;
+
+
diff --git a/body/fltk-widgets-groups-help_views.adb b/body/fltk-widgets-groups-help_views.adb
new file mode 100644
index 0000000..6435c0f
--- /dev/null
+++ b/body/fltk-widgets-groups-help_views.adb
@@ -0,0 +1,622 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C.Strings,
+ System.Address_To_Access_Conversions;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Groups.Help_Views is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_help_view
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_help_view, "new_fl_help_view");
+ pragma Inline (new_fl_help_view);
+
+ procedure free_fl_help_view
+ (V : in Storage.Integer_Address);
+ pragma Import (C, free_fl_help_view, "free_fl_help_view");
+ pragma Inline (free_fl_help_view);
+
+
+
+
+ procedure fl_help_view_clear_selection
+ (V : in Storage.Integer_Address);
+ pragma Import (C, fl_help_view_clear_selection, "fl_help_view_clear_selection");
+ pragma Inline (fl_help_view_clear_selection);
+
+ procedure fl_help_view_select_all
+ (V : in Storage.Integer_Address);
+ pragma Import (C, fl_help_view_select_all, "fl_help_view_select_all");
+ pragma Inline (fl_help_view_select_all);
+
+
+
+
+ function fl_help_view_find
+ (V : in Storage.Integer_Address;
+ S : in Interfaces.C.char_array;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_view_find, "fl_help_view_find");
+ pragma Inline (fl_help_view_find);
+
+ function fl_help_view_get_leftline
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_view_get_leftline, "fl_help_view_get_leftline");
+ pragma Inline (fl_help_view_get_leftline);
+
+ procedure fl_help_view_set_leftline
+ (V : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_help_view_set_leftline, "fl_help_view_set_leftline");
+ pragma Inline (fl_help_view_set_leftline);
+
+ function fl_help_view_get_topline
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_view_get_topline, "fl_help_view_get_topline");
+ pragma Inline (fl_help_view_get_topline);
+
+ procedure fl_help_view_set_topline
+ (V : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_help_view_set_topline, "fl_help_view_set_topline");
+ pragma Inline (fl_help_view_set_topline);
+
+ procedure fl_help_view_set_topline_target
+ (V : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_help_view_set_topline_target, "fl_help_view_set_topline_target");
+ pragma Inline (fl_help_view_set_topline_target);
+
+
+
+
+ function fl_help_view_directory
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_help_view_directory, "fl_help_view_directory");
+ pragma Inline (fl_help_view_directory);
+
+ function fl_help_view_filename
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_help_view_filename, "fl_help_view_filename");
+ pragma Inline (fl_help_view_filename);
+
+ function fl_help_view_load
+ (V : in Storage.Integer_Address;
+ F : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_view_load, "fl_help_view_load");
+ pragma Inline (fl_help_view_load);
+
+ function fl_help_view_title
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_help_view_title, "fl_help_view_title");
+ pragma Inline (fl_help_view_title);
+
+ function fl_help_view_get_value
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_help_view_get_value, "fl_help_view_get_value");
+ pragma Inline (fl_help_view_get_value);
+
+ procedure fl_help_view_set_value
+ (V : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_help_view_set_value, "fl_help_view_set_value");
+ pragma Inline (fl_help_view_set_value);
+
+ procedure fl_help_view_link
+ (V, F : in Storage.Integer_Address);
+ pragma Import (C, fl_help_view_link, "fl_help_view_link");
+ pragma Inline (fl_help_view_link);
+
+
+
+
+ function fl_help_view_get_scrollbar_size
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_view_get_scrollbar_size, "fl_help_view_get_scrollbar_size");
+ pragma Inline (fl_help_view_get_scrollbar_size);
+
+ procedure fl_help_view_set_scrollbar_size
+ (V : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_help_view_set_scrollbar_size, "fl_help_view_set_scrollbar_size");
+ pragma Inline (fl_help_view_set_scrollbar_size);
+
+ function fl_help_view_get_size
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_view_get_size, "fl_help_view_get_size");
+ pragma Inline (fl_help_view_get_size);
+
+ procedure fl_help_view_set_size
+ (V : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int);
+ pragma Import (C, fl_help_view_set_size, "fl_help_view_set_size");
+ pragma Inline (fl_help_view_set_size);
+
+ procedure fl_help_view_resize
+ (V : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_help_view_resize, "fl_help_view_resize");
+ pragma Inline (fl_help_view_resize);
+
+ function fl_help_view_get_textcolor
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_help_view_get_textcolor, "fl_help_view_get_textcolor");
+ pragma Inline (fl_help_view_get_textcolor);
+
+ procedure fl_help_view_set_textcolor
+ (V : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_help_view_set_textcolor, "fl_help_view_set_textcolor");
+ pragma Inline (fl_help_view_set_textcolor);
+
+ function fl_help_view_get_textfont
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_view_get_textfont, "fl_help_view_get_textfont");
+ pragma Inline (fl_help_view_get_textfont);
+
+ procedure fl_help_view_set_textfont
+ (V : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_help_view_set_textfont, "fl_help_view_set_textfont");
+ pragma Inline (fl_help_view_set_textfont);
+
+ function fl_help_view_get_textsize
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_view_get_textsize, "fl_help_view_get_textsize");
+ pragma Inline (fl_help_view_get_textsize);
+
+ procedure fl_help_view_set_textsize
+ (V : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_help_view_set_textsize, "fl_help_view_set_textsize");
+ pragma Inline (fl_help_view_set_textsize);
+
+
+
+
+ procedure fl_help_view_draw
+ (V : in Storage.Integer_Address);
+ pragma Import (C, fl_help_view_draw, "fl_help_view_draw");
+ pragma Inline (fl_help_view_draw);
+
+ function fl_help_view_handle
+ (V : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_help_view_handle, "fl_help_view_handle");
+ pragma Inline (fl_help_view_handle);
+
+
+
+
+ ----------------------
+ -- Callback Hooks --
+ ----------------------
+
+ package Help_View_Convert is new System.Address_To_Access_Conversions (Help_View'Class);
+
+ function Link_Callback_Hook
+ (V : in Storage.Integer_Address;
+ S : in Interfaces.C.Strings.chars_ptr)
+ return Interfaces.C.Strings.chars_ptr;
+
+ pragma Convention (C, Link_Callback_Hook);
+
+ function Link_Callback_Hook
+ (V : in Storage.Integer_Address;
+ S : in Interfaces.C.Strings.chars_ptr)
+ return Interfaces.C.Strings.chars_ptr
+ is
+ User_Data : Storage.Integer_Address := fl_widget_get_user_data (V);
+ Ada_Help_View : access Help_View'Class;
+ begin
+ pragma Assert (User_Data /= Null_Pointer);
+ Ada_Help_View := Help_View_Convert.To_Pointer (Storage.To_Address (User_Data));
+ if Ada_Help_View.Zelda = null then
+ return S;
+ end if;
+ Interfaces.C.Strings.Free (Ada_Help_View.Hilda);
+ Ada_Help_View.Hilda := Interfaces.C.Strings.New_String
+ (Ada_Help_View.Zelda (Ada_Help_View.all, Interfaces.C.Strings.Value (S)));
+ if Interfaces.C.Strings.Value (Ada_Help_View.Hilda) = "" then
+ return Interfaces.C.Strings.Null_Ptr;
+ else
+ return Ada_Help_View.Hilda;
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Link_Callback_Hook;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Help_View) is
+ begin
+ Interfaces.C.Strings.Free (This.Hilda);
+ Extra_Final (Group (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Help_View) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_help_view (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Help_View;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ fl_help_view_link (This.Void_Ptr, Storage.To_Integer (Link_Callback_Hook'Address));
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Help_View) is
+ begin
+ This.Draw_Ptr := fl_help_view_draw'Address;
+ This.Handle_Ptr := fl_help_view_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Help_View is
+ begin
+ return This : Help_View do
+ This.Void_Ptr := new_fl_help_view
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Help_View is
+ begin
+ return This : Help_View := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Clear_Selection
+ (This : in out Help_View) is
+ begin
+ fl_help_view_clear_selection (This.Void_Ptr);
+ end Clear_Selection;
+
+
+ procedure Select_All
+ (This : in out Help_View) is
+ begin
+ fl_help_view_select_all (This.Void_Ptr);
+ end Select_All;
+
+
+
+
+ function Find
+ (This : in Help_View;
+ Item : in String;
+ From : in Position := 1)
+ return Extended_Position is
+ begin
+ return Extended_Position (fl_help_view_find
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Item),
+ Interfaces.C.int (From) - 1) + 1);
+ end Find;
+
+
+ function Get_Leftline_Pixel
+ (This : in Help_View)
+ return Natural is
+ begin
+ return Natural (fl_help_view_get_leftline (This.Void_Ptr));
+ end Get_Leftline_Pixel;
+
+
+ procedure Set_Leftline_Pixel
+ (This : in out Help_View;
+ Value : in Natural) is
+ begin
+ fl_help_view_set_leftline (This.Void_Ptr, Interfaces.C.int (Value));
+ end Set_Leftline_Pixel;
+
+
+ function Get_Topline_Pixel
+ (This : in Help_View)
+ return Natural is
+ begin
+ return Natural (fl_help_view_get_topline (This.Void_Ptr));
+ end Get_Topline_Pixel;
+
+
+ procedure Set_Topline_Pixel
+ (This : in out Help_View;
+ Value : in Natural) is
+ begin
+ fl_help_view_set_topline (This.Void_Ptr, Interfaces.C.int (Value));
+ end Set_Topline_Pixel;
+
+
+ procedure Set_Topline_Target
+ (This : in out Help_View;
+ Value : in String) is
+ begin
+ fl_help_view_set_topline_target (This.Void_Ptr, Interfaces.C.To_C (Value));
+ end Set_Topline_Target;
+
+
+
+
+ function Current_Directory
+ (This : in Help_View)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_help_view_directory (This.Void_Ptr));
+ end Current_Directory;
+
+
+ function Current_File
+ (This : in Help_View)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_help_view_filename (This.Void_Ptr));
+ end Current_File;
+
+
+ procedure Load
+ (This : in out Help_View;
+ Name : in String)
+ is
+ Code : Interfaces.C.int := fl_help_view_load (This.Void_Ptr, Interfaces.C.To_C (Name));
+ begin
+ if Code = -1 then
+ raise Load_Help_Error;
+ else
+ pragma Assert (Code = 0);
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Load;
+
+
+ function Document_Title
+ (This : in Help_View)
+ return String
+ is
+ Raw_Chars : Interfaces.C.Strings.chars_ptr := fl_help_view_title (This.Void_Ptr);
+ use type Interfaces.C.Strings.chars_ptr;
+ begin
+ if Raw_Chars = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Raw_Chars);
+ end if;
+ end Document_Title;
+
+
+ function Get_Content
+ (This : in Help_View)
+ return String
+ is
+ Raw_Chars : Interfaces.C.Strings.chars_ptr := fl_help_view_get_value (This.Void_Ptr);
+ use type Interfaces.C.Strings.chars_ptr;
+ begin
+ if Raw_Chars = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Raw_Chars);
+ end if;
+ end Get_Content;
+
+
+ procedure Set_Content
+ (This : in out Help_View;
+ Value : in String) is
+ begin
+ fl_help_view_set_value (This.Void_Ptr, Interfaces.C.To_C (Value));
+ end Set_Content;
+
+
+ procedure Set_Link_Callback
+ (This : in out Help_View;
+ Func : in Link_Callback) is
+ begin
+ This.Zelda := Func;
+ end Set_Link_Callback;
+
+
+
+
+ function Get_Scrollbar_Size
+ (This : in Help_View)
+ return Natural is
+ begin
+ return Natural (fl_help_view_get_scrollbar_size (This.Void_Ptr));
+ end Get_Scrollbar_Size;
+
+
+ procedure Set_Scrollbar_Size
+ (This : in out Help_View;
+ Value : in Natural) is
+ begin
+ fl_help_view_set_scrollbar_size (This.Void_Ptr, Interfaces.C.int (Value));
+ end Set_Scrollbar_Size;
+
+
+ function Get_Size
+ (This : in Help_View)
+ return Integer is
+ begin
+ return Integer (fl_help_view_get_size (This.Void_Ptr));
+ end Get_Size;
+
+
+ procedure Resize
+ (This : in out Help_View;
+ W, H : in Integer) is
+ begin
+ fl_help_view_set_size
+ (This.Void_Ptr,
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+ procedure Resize
+ (This : in out Help_View;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_help_view_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+ function Get_Text_Color
+ (This : in Help_View)
+ return Color is
+ begin
+ return Color (fl_help_view_get_textcolor (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Help_View;
+ Value : in Color) is
+ begin
+ fl_help_view_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (Value));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Help_View)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_help_view_get_textfont (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Help_View;
+ Font : in Font_Kind) is
+ begin
+ fl_help_view_set_textfont (This.Void_Ptr, Font_Kind'Pos (Font));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Help_View)
+ return Font_Size is
+ begin
+ return Font_Size (fl_help_view_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Help_View;
+ Size : in Font_Size) is
+ begin
+ fl_help_view_set_textsize (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Text_Size;
+
+
+
+
+ procedure Draw
+ (This : in out Help_View) is
+ begin
+ Group (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Help_View;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Group (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Groups.Help_Views;
+
+
diff --git a/body/fltk-widgets-groups-input_choices.adb b/body/fltk-widgets-groups-input_choices.adb
new file mode 100644
index 0000000..4ee6ffd
--- /dev/null
+++ b/body/fltk-widgets-groups-input_choices.adb
@@ -0,0 +1,501 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets.Groups.Input_Choices is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_input_choice
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_input_choice, "new_fl_input_choice");
+ pragma Inline (new_fl_input_choice);
+
+ procedure free_fl_input_choice
+ (W : in Storage.Integer_Address);
+ pragma Import (C, free_fl_input_choice, "free_fl_input_choice");
+ pragma Inline (free_fl_input_choice);
+
+
+
+
+ function fl_input_choice_input
+ (N : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_input_choice_input, "fl_input_choice_input");
+ pragma Inline (fl_input_choice_input);
+
+ function fl_input_choice_menubutton
+ (N : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_input_choice_menubutton, "fl_input_choice_menubutton");
+ pragma Inline (fl_input_choice_menubutton);
+
+
+
+
+ procedure fl_input_choice_clear
+ (N : in Storage.Integer_Address);
+ pragma Import (C, fl_input_choice_clear, "fl_input_choice_clear");
+ pragma Inline (fl_input_choice_clear);
+
+
+
+
+ function fl_input_choice_changed
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_choice_changed, "fl_input_choice_changed");
+ pragma Inline (fl_input_choice_changed);
+
+ procedure fl_input_choice_clear_changed
+ (N : in Storage.Integer_Address);
+ pragma Import (C, fl_input_choice_clear_changed, "fl_input_choice_clear_changed");
+ pragma Inline (fl_input_choice_clear_changed);
+
+ procedure fl_input_choice_set_changed
+ (N : in Storage.Integer_Address);
+ pragma Import (C, fl_input_choice_set_changed, "fl_input_choice_set_changed");
+ pragma Inline (fl_input_choice_set_changed);
+
+ function fl_input_choice_get_down_box
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_choice_get_down_box, "fl_input_choice_get_down_box");
+ pragma Inline (fl_input_choice_get_down_box);
+
+ procedure fl_input_choice_set_down_box
+ (N : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_choice_set_down_box, "fl_input_choice_set_down_box");
+ pragma Inline (fl_input_choice_set_down_box);
+
+ function fl_input_choice_get_textcolor
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_input_choice_get_textcolor, "fl_input_choice_get_textcolor");
+ pragma Inline (fl_input_choice_get_textcolor);
+
+ procedure fl_input_choice_set_textcolor
+ (N : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned);
+ pragma Import (C, fl_input_choice_set_textcolor, "fl_input_choice_set_textcolor");
+ pragma Inline (fl_input_choice_set_textcolor);
+
+ function fl_input_choice_get_textfont
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_choice_get_textfont, "fl_input_choice_get_textfont");
+ pragma Inline (fl_input_choice_get_textfont);
+
+ procedure fl_input_choice_set_textfont
+ (N : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_choice_set_textfont, "fl_input_choice_set_textfont");
+ pragma Inline (fl_input_choice_set_textfont);
+
+ function fl_input_choice_get_textsize
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_choice_get_textsize, "fl_input_choice_get_textsize");
+ pragma Inline (fl_input_choice_get_textsize);
+
+ procedure fl_input_choice_set_textsize
+ (N : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_choice_set_textsize, "fl_input_choice_set_textsize");
+ pragma Inline (fl_input_choice_set_textsize);
+
+ function fl_input_choice_get_value
+ (N : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_input_choice_get_value, "fl_input_choice_get_value");
+ pragma Inline (fl_input_choice_get_value);
+
+ procedure fl_input_choice_set_value
+ (N : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_input_choice_set_value, "fl_input_choice_set_value");
+ pragma Inline (fl_input_choice_set_value);
+
+ procedure fl_input_choice_set_value2
+ (N : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_choice_set_value2, "fl_input_choice_set_value2");
+ pragma Inline (fl_input_choice_set_value2);
+
+
+
+
+ procedure fl_input_choice_resize
+ (N : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_input_choice_resize, "fl_input_choice_resize");
+ pragma Inline (fl_input_choice_resize);
+
+
+
+
+ procedure fl_input_choice_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_input_choice_draw, "fl_input_choice_draw");
+ pragma Inline (fl_input_choice_draw);
+
+ function fl_input_choice_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_choice_handle, "fl_input_choice_handle");
+ pragma Inline (fl_input_choice_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ -- Resorting to smoke signals
+ procedure fl_text_input_extra_final
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Import (C, fl_text_input_extra_final, "fl_text_input_extra_final");
+ pragma Inline (fl_text_input_extra_final);
+
+
+ -- Message in a bottle
+ procedure fl_menu_button_extra_final
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_button_extra_final, "fl_menu_button_extra_final");
+ pragma Inline (fl_menu_button_extra_final);
+
+
+ procedure Extra_Final
+ (This : in out Input_Choice) is
+ begin
+ fl_text_input_extra_final (Storage.To_Integer (This.My_Input'Address));
+ fl_menu_button_extra_final (Storage.To_Integer (This.My_Menu_Button'Address));
+ Extra_Final (Group (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Input_Choice) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_input_choice (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ -- Translocation initiating...
+ procedure fl_text_input_extra_init
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.char_array);
+ pragma Import (C, fl_text_input_extra_init, "fl_text_input_extra_init");
+ pragma Inline (fl_text_input_extra_init);
+
+
+ -- Crossing the streams
+ procedure fl_menu_button_extra_init
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.char_array);
+ pragma Import (C, fl_menu_button_extra_init, "fl_menu_button_extra_init");
+ pragma Inline (fl_menu_button_extra_init);
+
+
+ procedure Extra_Init
+ (This : in out Input_Choice;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Wrapper (This.My_Input).Void_Ptr := fl_input_choice_input (This.Void_Ptr);
+ Wrapper (This.My_Input).Needs_Dealloc := False;
+ fl_text_input_extra_init
+ (Storage.To_Integer (This.My_Input'Address),
+ Interfaces.C.int (This.My_Input.Get_X),
+ Interfaces.C.int (This.My_Input.Get_Y),
+ Interfaces.C.int (This.My_Input.Get_W),
+ Interfaces.C.int (This.My_Input.Get_H),
+ Interfaces.C.To_C (This.My_Input.Get_Label));
+ Wrapper (This.My_Menu_Button).Void_Ptr := fl_input_choice_menubutton (This.Void_Ptr);
+ Wrapper (This.My_Menu_Button).Needs_Dealloc := False;
+ fl_menu_button_extra_init
+ (Storage.To_Integer (This.My_Menu_Button'Address),
+ Interfaces.C.int (This.My_Menu_Button.Get_X),
+ Interfaces.C.int (This.My_Menu_Button.Get_Y),
+ Interfaces.C.int (This.My_Menu_Button.Get_W),
+ Interfaces.C.int (This.My_Menu_Button.Get_H),
+ Interfaces.C.To_C (This.My_Menu_Button.Get_Label));
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Input_Choice) is
+ begin
+ This.Draw_Ptr := fl_input_choice_draw'Address;
+ This.Handle_Ptr := fl_input_choice_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Input_Choice is
+ begin
+ return This : Input_Choice do
+ This.Void_Ptr := new_fl_input_choice
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Input_Choice is
+ begin
+ return This : Input_Choice := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ ------------------
+ -- Attributes --
+ ------------------
+
+ function Text_Field
+ (This : in out Input_Choice)
+ return FLTK.Widgets.Inputs.Text.Text_Input_Reference is
+ begin
+ return (Data => This.My_Input'Unchecked_Access);
+ end Text_Field;
+
+
+ function Button_Menu
+ (This : in out Input_Choice)
+ return FLTK.Widgets.Menus.Menu_Buttons.Menu_Button_Reference is
+ begin
+ return (Data => This.My_Menu_Button'Unchecked_Access);
+ end Button_Menu;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Has_Item
+ (This : in Input_Choice;
+ Place : in FLTK.Widgets.Menus.Index)
+ return Boolean is
+ begin
+ return This.My_Menu_Button.Has_Item (Place);
+ end Has_Item;
+
+
+ function Item
+ (This : in Input_Choice;
+ Place : in FLTK.Widgets.Menus.Index)
+ return FLTK.Menu_Items.Menu_Item_Reference is
+ begin
+ return This.My_Menu_Button.Item (Place);
+ end Item;
+
+
+ procedure Use_Same_Items
+ (This : in out Input_Choice;
+ Donor : in FLTK.Widgets.Menus.Menu'Class) is
+ begin
+ This.My_Menu_Button.Use_Same_Items (Donor);
+ end Use_Same_Items;
+
+
+ procedure Clear
+ (This : in out Input_Choice) is
+ begin
+ fl_input_choice_clear (This.Void_Ptr);
+ end Clear;
+
+
+
+
+ function Has_Changed
+ (This : in Input_Choice)
+ return Boolean is
+ begin
+ return fl_input_choice_changed (This.Void_Ptr) /= 0;
+ end Has_Changed;
+
+
+ procedure Clear_Changed
+ (This : in out Input_Choice) is
+ begin
+ fl_input_choice_clear_changed (This.Void_Ptr);
+ end Clear_Changed;
+
+
+ procedure Set_Changed
+ (This : in out Input_Choice;
+ To : in Boolean) is
+ begin
+ if To then
+ fl_input_choice_set_changed (This.Void_Ptr);
+ end if;
+ end Set_Changed;
+
+
+ function Get_Down_Box
+ (This : in Input_Choice)
+ return Box_Kind is
+ begin
+ return Box_Kind'Val (fl_input_choice_get_down_box (This.Void_Ptr));
+ end Get_Down_Box;
+
+
+ procedure Set_Down_Box
+ (This : in out Input_Choice;
+ To : in Box_Kind) is
+ begin
+ fl_input_choice_set_down_box (This.Void_Ptr, Box_Kind'Pos (To));
+ end Set_Down_Box;
+
+
+ function Get_Text_Color
+ (This : in Input_Choice)
+ return Color is
+ begin
+ return Color (fl_input_choice_get_textcolor (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Input_Choice;
+ To : in Color) is
+ begin
+ fl_input_choice_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Input_Choice)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_input_choice_get_textfont (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Input_Choice;
+ To : in Font_Kind) is
+ begin
+ fl_input_choice_set_textfont (This.Void_Ptr, Font_Kind'Pos (To));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Input_Choice)
+ return Font_Size is
+ begin
+ return Font_Size (fl_input_choice_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Input_Choice;
+ To : in Font_Size) is
+ begin
+ fl_input_choice_set_textsize (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Text_Size;
+
+
+ function Get_Input
+ (This : in Input_Choice)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_input_choice_get_value (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ -- pointer to internal buffer so no free necessary
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Get_Input;
+
+
+ procedure Set_Input
+ (This : in out Input_Choice;
+ To : in String) is
+ begin
+ fl_input_choice_set_value (This.Void_Ptr, Interfaces.C.To_C (To));
+ end Set_Input;
+
+
+ procedure Set_Item
+ (This : in out Input_Choice;
+ Num : in Integer) is
+ begin
+ fl_input_choice_set_value2 (This.Void_Ptr, Interfaces.C.int (Num));
+ end Set_Item;
+
+
+
+
+ procedure Resize
+ (This : in out Input_Choice;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_input_choice_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+end FLTK.Widgets.Groups.Input_Choices;
+
+
diff --git a/body/fltk-widgets-groups-packed.adb b/body/fltk-widgets-groups-packed.adb
new file mode 100644
index 0000000..126da76
--- /dev/null
+++ b/body/fltk-widgets-groups-packed.adb
@@ -0,0 +1,197 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Groups.Packed is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_pack
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_pack, "new_fl_pack");
+ pragma Inline (new_fl_pack);
+
+ procedure free_fl_pack
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_pack, "free_fl_pack");
+ pragma Inline (free_fl_pack);
+
+
+
+
+ function fl_pack_get_spacing
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_pack_get_spacing, "fl_pack_get_spacing");
+ pragma Inline (fl_pack_get_spacing);
+
+ procedure fl_pack_set_spacing
+ (P : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_pack_set_spacing, "fl_pack_set_spacing");
+ pragma Inline (fl_pack_set_spacing);
+
+
+
+
+ procedure fl_pack_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_pack_draw, "fl_pack_draw");
+ pragma Inline (fl_pack_draw);
+
+ function fl_pack_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_pack_handle, "fl_pack_handle");
+ pragma Inline (fl_pack_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Packed_Group) is
+ begin
+ Extra_Final (Group (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Packed_Group) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_pack (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Packed_Group;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Packed_Group) is
+ begin
+ This.Draw_Ptr := fl_pack_draw'Address;
+ This.Handle_Ptr := fl_pack_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Packed_Group is
+ begin
+ return This : Packed_Group do
+ This.Void_Ptr := new_fl_pack
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Packed_Group is
+ begin
+ return This : Packed_Group := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Spacing
+ (This : in Packed_Group)
+ return Integer is
+ begin
+ return Integer (fl_pack_get_spacing (This.Void_Ptr));
+ end Get_Spacing;
+
+
+ procedure Set_Spacing
+ (This : in out Packed_Group;
+ To : in Integer) is
+ begin
+ fl_pack_set_spacing (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Spacing;
+
+
+ function Get_Kind
+ (This : in Packed_Group)
+ return Pack_Kind
+ is
+ Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr);
+ begin
+ return Pack_Kind'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Pack::type returned unexpected unsigned char value of " &
+ Interfaces.C.unsigned_char'Image (Result);
+ end Get_Kind;
+
+
+ procedure Set_Kind
+ (This : in out Packed_Group;
+ Kind : in Pack_Kind) is
+ begin
+ fl_widget_set_type (This.Void_Ptr, Pack_Kind'Pos (Kind));
+ end Set_Kind;
+
+
+
+
+ procedure Draw
+ (This : in out Packed_Group) is
+ begin
+ Group (This).Draw;
+ end Draw;
+
+
+end FLTK.Widgets.Groups.Packed;
+
+
diff --git a/body/fltk-widgets-groups-scrolls.adb b/body/fltk-widgets-groups-scrolls.adb
new file mode 100644
index 0000000..a4885dc
--- /dev/null
+++ b/body/fltk-widgets-groups-scrolls.adb
@@ -0,0 +1,346 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+use type
+
+ Interfaces.C.unsigned_char;
+
+
+package body FLTK.Widgets.Groups.Scrolls is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_scroll
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_scroll, "new_fl_scroll");
+ pragma Inline (new_fl_scroll);
+
+ procedure free_fl_scroll
+ (S : in Storage.Integer_Address);
+ pragma Import (C, free_fl_scroll, "free_fl_scroll");
+ pragma Inline (free_fl_scroll);
+
+
+
+
+ function fl_scroll_hscrollbar
+ (S : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_scroll_hscrollbar, "fl_scroll_hscrollbar");
+ pragma Inline (fl_scroll_hscrollbar);
+
+ function fl_scroll_scrollbar
+ (S : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_scroll_scrollbar, "fl_scroll_scrollbar");
+ pragma Inline (fl_scroll_scrollbar);
+
+
+
+
+ procedure fl_scroll_to
+ (S : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_scroll_to, "fl_scroll_to");
+ pragma Inline (fl_scroll_to);
+
+ function fl_scroll_xposition
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_scroll_xposition, "fl_scroll_xposition");
+ pragma Inline (fl_scroll_xposition);
+
+ function fl_scroll_yposition
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_scroll_yposition, "fl_scroll_yposition");
+ pragma Inline (fl_scroll_yposition);
+
+
+
+
+ function fl_scroll_get_size
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_scroll_get_size, "fl_scroll_get_size");
+ pragma Inline (fl_scroll_get_size);
+
+ procedure fl_scroll_set_size
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_scroll_set_size, "fl_scroll_set_size");
+ pragma Inline (fl_scroll_set_size);
+
+
+
+
+ procedure fl_scroll_draw
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_scroll_draw, "fl_scroll_draw");
+ pragma Inline (fl_scroll_draw);
+
+ function fl_scroll_handle
+ (S : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_scroll_handle, "fl_scroll_handle");
+ pragma Inline (fl_scroll_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ -- It's the only way to be sure
+ procedure fl_scrollbar_extra_final
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Import (C, fl_scrollbar_extra_final, "fl_scrollbar_extra_final");
+ pragma Inline (fl_scrollbar_extra_final);
+
+
+ procedure Extra_Final
+ (This : in out Scroll) is
+ begin
+ fl_scrollbar_extra_final (Storage.To_Integer (This.Horizon'Address));
+ fl_scrollbar_extra_final (Storage.To_Integer (This.Vertigo'Address));
+ Extra_Final (Group (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Scroll) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_scroll (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ -- Hold on, I know a shortcut
+ procedure fl_scrollbar_extra_init
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.char_array);
+ pragma Import (C, fl_scrollbar_extra_init, "fl_scrollbar_extra_init");
+ pragma Inline (fl_scrollbar_extra_init);
+
+
+ procedure Extra_Init
+ (This : in out Scroll;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Widget (This.Horizon).Void_Ptr := fl_scroll_hscrollbar (This.Void_Ptr);
+ Widget (This.Horizon).Needs_Dealloc := False;
+ fl_scrollbar_extra_init
+ (Storage.To_Integer (This.Horizon'Address),
+ Interfaces.C.int (This.Horizon.Get_X),
+ Interfaces.C.int (This.Horizon.Get_Y),
+ Interfaces.C.int (This.Horizon.Get_W),
+ Interfaces.C.int (This.Horizon.Get_H),
+ Interfaces.C.To_C (This.Horizon.Get_Label));
+ Widget (This.Vertigo).Void_Ptr := fl_scroll_scrollbar (This.Void_Ptr);
+ Widget (This.Vertigo).Needs_Dealloc := False;
+ fl_scrollbar_extra_init
+ (Storage.To_Integer (This.Vertigo'Address),
+ Interfaces.C.int (This.Vertigo.Get_X),
+ Interfaces.C.int (This.Vertigo.Get_Y),
+ Interfaces.C.int (This.Vertigo.Get_W),
+ Interfaces.C.int (This.Vertigo.Get_H),
+ Interfaces.C.To_C (This.Vertigo.Get_Label));
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Scroll) is
+ begin
+ This.Draw_Ptr := fl_scroll_draw'Address;
+ This.Handle_Ptr := fl_scroll_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Scroll is
+ begin
+ return This : Scroll do
+ This.Void_Ptr := new_fl_scroll
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Scroll is
+ begin
+ return This : Scroll := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ ------------------
+ -- Attributes --
+ ------------------
+
+ function H_Bar
+ (This : in out Scroll)
+ return Valuators.Sliders.Scrollbars.Scrollbar_Reference is
+ begin
+ return (Data => This.Horizon'Unchecked_Access);
+ end H_Bar;
+
+
+ function V_Bar
+ (This : in out Scroll)
+ return Valuators.Sliders.Scrollbars.Scrollbar_Reference is
+ begin
+ return (Data => This.Vertigo'Unchecked_Access);
+ end V_Bar;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Clear
+ (This : in out Scroll) is
+ begin
+ -- Can't use the actual clear method here because that would
+ -- delete the widgets from memory, and the binding is meant to
+ -- handle that, not the library.
+ This.Remove (This.Horizon);
+ This.Remove (This.Vertigo);
+ Group (This).Clear;
+ This.Add (This.Horizon);
+ This.Add (This.Vertigo);
+ end Clear;
+
+
+
+
+ procedure Scroll_To
+ (This : in out Scroll;
+ X, Y : in Integer) is
+ begin
+ fl_scroll_to (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y));
+ end Scroll_To;
+
+
+ function Get_Scroll_X
+ (This : in Scroll)
+ return Integer is
+ begin
+ return Integer (fl_scroll_xposition (This.Void_Ptr));
+ end Get_Scroll_X;
+
+
+ function Get_Scroll_Y
+ (This : in Scroll)
+ return Integer is
+ begin
+ return Integer (fl_scroll_yposition (This.Void_Ptr));
+ end Get_Scroll_Y;
+
+
+
+
+ function Get_Scrollbar_Size
+ (This : in Scroll)
+ return Integer is
+ begin
+ return Integer (fl_scroll_get_size (This.Void_Ptr));
+ end Get_Scrollbar_Size;
+
+
+ procedure Set_Scrollbar_Size
+ (This : in out Scroll;
+ To : in Integer) is
+ begin
+ fl_scroll_set_size (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Scrollbar_Size;
+
+
+ function Get_Kind
+ (This : in Scroll)
+ return Scroll_Kind
+ is
+ Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr);
+ begin
+ return Scroll_Kind'Val (Result - 1);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Scroll::type returned unexpected unsigned char value of " &
+ Interfaces.C.unsigned_char'Image (Result);
+ end Get_Kind;
+
+
+ procedure Set_Kind
+ (This : in out Scroll;
+ Mode : in Scroll_Kind) is
+ begin
+ fl_widget_set_type (This.Void_Ptr, Scroll_Kind'Pos (Mode));
+ end Set_Kind;
+
+
+
+
+ procedure Draw
+ (This : in out Scroll) is
+ begin
+ Group (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Scroll;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Group (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Groups.Scrolls;
+
+
diff --git a/body/fltk-widgets-groups-spinners.adb b/body/fltk-widgets-groups-spinners.adb
new file mode 100644
index 0000000..d73d3e9
--- /dev/null
+++ b/body/fltk-widgets-groups-spinners.adb
@@ -0,0 +1,536 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.unsigned_char,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets.Groups.Spinners is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_spinner
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_spinner, "new_fl_spinner");
+ pragma Inline (new_fl_spinner);
+
+ procedure free_fl_spinner
+ (W : in Storage.Integer_Address);
+ pragma Import (C, free_fl_spinner, "free_fl_spinner");
+ pragma Inline (free_fl_spinner);
+
+
+
+
+ function fl_spinner_get_color
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_spinner_get_color, "fl_spinner_get_color");
+ pragma Inline (fl_spinner_get_color);
+
+ procedure fl_spinner_set_color
+ (S : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_spinner_set_color, "fl_spinner_set_color");
+ pragma Inline (fl_spinner_set_color);
+
+ function fl_spinner_get_selection_color
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_spinner_get_selection_color, "fl_spinner_get_selection_color");
+ pragma Inline (fl_spinner_get_selection_color);
+
+ procedure fl_spinner_set_selection_color
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned);
+ pragma Import (C, fl_spinner_set_selection_color, "fl_spinner_set_selection_color");
+ pragma Inline (fl_spinner_set_selection_color);
+
+ function fl_spinner_get_textcolor
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_spinner_get_textcolor, "fl_spinner_get_textcolor");
+ pragma Inline (fl_spinner_get_textcolor);
+
+ procedure fl_spinner_set_textcolor
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned);
+ pragma Import (C, fl_spinner_set_textcolor, "fl_spinner_set_textcolor");
+ pragma Inline (fl_spinner_set_textcolor);
+
+ function fl_spinner_get_textfont
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_spinner_get_textfont, "fl_spinner_get_textfont");
+ pragma Inline (fl_spinner_get_textfont);
+
+ procedure fl_spinner_set_textfont
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_spinner_set_textfont, "fl_spinner_set_textfont");
+ pragma Inline (fl_spinner_set_textfont);
+
+ function fl_spinner_get_textsize
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_spinner_get_textsize, "fl_spinner_get_textsize");
+ pragma Inline (fl_spinner_get_textsize);
+
+ procedure fl_spinner_set_textsize
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_spinner_set_textsize, "fl_spinner_set_textsize");
+ pragma Inline (fl_spinner_set_textsize);
+
+
+
+
+ function fl_spinner_get_minimum
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_spinner_get_minimum, "fl_spinner_get_minimum");
+ pragma Inline (fl_spinner_get_minimum);
+
+ procedure fl_spinner_set_minimum
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.double);
+ pragma Import (C, fl_spinner_set_minimum, "fl_spinner_set_minimum");
+ pragma Inline (fl_spinner_set_minimum);
+
+ function fl_spinner_get_maximum
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_spinner_get_maximum, "fl_spinner_get_maximum");
+ pragma Inline (fl_spinner_get_maximum);
+
+ procedure fl_spinner_set_maximum
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.double);
+ pragma Import (C, fl_spinner_set_maximum, "fl_spinner_set_maximum");
+ pragma Inline (fl_spinner_set_maximum);
+
+ procedure fl_spinner_range
+ (S : in Storage.Integer_Address;
+ A, B : in Interfaces.C.double);
+ pragma Import (C, fl_spinner_range, "fl_spinner_range");
+ pragma Inline (fl_spinner_range);
+
+ function fl_spinner_get_step
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_spinner_get_step, "fl_spinner_get_step");
+ pragma Inline (fl_spinner_get_step);
+
+ procedure fl_spinner_set_step
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.double);
+ pragma Import (C, fl_spinner_set_step, "fl_spinner_set_step");
+ pragma Inline (fl_spinner_set_step);
+
+ function fl_spinner_get_value
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_spinner_get_value, "fl_spinner_get_value");
+ pragma Inline (fl_spinner_get_value);
+
+ procedure fl_spinner_set_value
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.double);
+ pragma Import (C, fl_spinner_set_value, "fl_spinner_set_value");
+ pragma Inline (fl_spinner_set_value);
+
+
+
+
+ function fl_spinner_get_format
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_spinner_get_format, "fl_spinner_get_format");
+ pragma Inline (fl_spinner_get_format);
+
+ procedure fl_spinner_set_format
+ (S : in Storage.Integer_Address;
+ F : in Interfaces.C.Strings.chars_ptr);
+ pragma Import (C, fl_spinner_set_format, "fl_spinner_set_format");
+ pragma Inline (fl_spinner_set_format);
+
+ function fl_spinner_get_type
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.unsigned_char;
+ pragma Import (C, fl_spinner_get_type, "fl_spinner_get_type");
+ pragma Inline (fl_spinner_get_type);
+
+ procedure fl_spinner_set_type
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_spinner_set_type, "fl_spinner_set_type");
+ pragma Inline (fl_spinner_set_type);
+
+
+
+
+ procedure fl_spinner_resize
+ (S : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_spinner_resize, "fl_spinner_resize");
+ pragma Inline (fl_spinner_resize);
+
+
+
+
+ procedure fl_spinner_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_spinner_draw, "fl_spinner_draw");
+ pragma Inline (fl_spinner_draw);
+
+ function fl_spinner_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_spinner_handle, "fl_spinner_handle");
+ pragma Inline (fl_spinner_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Spinner) is
+ begin
+ Extra_Final (Group (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Spinner) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_spinner (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Spinner;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Spinner) is
+ begin
+ This.Draw_Ptr := fl_spinner_draw'Address;
+ This.Handle_Ptr := fl_spinner_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Spinner is
+ begin
+ return This : Spinner do
+ This.Void_Ptr := new_fl_spinner
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Spinner is
+ begin
+ return This : Spinner := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Background_Color
+ (This : in Spinner)
+ return Color is
+ begin
+ return Color (fl_spinner_get_color (This.Void_Ptr));
+ end Get_Background_Color;
+
+
+ procedure Set_Background_Color
+ (This : in out Spinner;
+ To : in Color) is
+ begin
+ fl_spinner_set_color (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Background_Color;
+
+
+ function Get_Selection_Color
+ (This : in Spinner)
+ return Color is
+ begin
+ return Color (fl_spinner_get_selection_color (This.Void_Ptr));
+ end Get_Selection_Color;
+
+
+ procedure Set_Selection_Color
+ (This : in out Spinner;
+ To : in Color) is
+ begin
+ fl_spinner_set_selection_color (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Selection_Color;
+
+
+ function Get_Text_Color
+ (This : in Spinner)
+ return Color is
+ begin
+ return Color (fl_spinner_get_textcolor (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Spinner;
+ To : in Color) is
+ begin
+ fl_spinner_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Spinner)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_spinner_get_textfont (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Spinner;
+ To : in Font_Kind) is
+ begin
+ fl_spinner_set_textfont (This.Void_Ptr, Font_Kind'Pos (To));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Spinner)
+ return Font_Size is
+ begin
+ return Font_Size (fl_spinner_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Spinner;
+ To : in Font_Size) is
+ begin
+ fl_spinner_set_textsize (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Text_Size;
+
+
+
+
+ function Get_Minimum
+ (This : in Spinner)
+ return Long_Float is
+ begin
+ return Long_Float (fl_spinner_get_minimum (This.Void_Ptr));
+ end Get_Minimum;
+
+
+ procedure Set_Minimum
+ (This : in out Spinner;
+ To : in Long_Float) is
+ begin
+ fl_spinner_set_minimum (This.Void_Ptr, Interfaces.C.double (To));
+ end Set_Minimum;
+
+
+ function Get_Maximum
+ (This : in Spinner)
+ return Long_Float is
+ begin
+ return Long_Float (fl_spinner_get_maximum (This.Void_Ptr));
+ end Get_Maximum;
+
+
+ procedure Set_Maximum
+ (This : in out Spinner;
+ To : in Long_Float) is
+ begin
+ fl_spinner_set_maximum (This.Void_Ptr, Interfaces.C.double (To));
+ end Set_Maximum;
+
+
+ procedure Get_Range
+ (This : in Spinner;
+ Min, Max : out Long_Float) is
+ begin
+ Min := Long_Float (fl_spinner_get_minimum (This.Void_Ptr));
+ Max := Long_Float (fl_spinner_get_maximum (This.Void_Ptr));
+ end Get_Range;
+
+
+ procedure Set_Range
+ (This : in out Spinner;
+ Min, Max : in Long_Float) is
+ begin
+ fl_spinner_range
+ (This.Void_Ptr,
+ Interfaces.C.double (Min),
+ Interfaces.C.double (Max));
+ end Set_Range;
+
+
+ function Get_Step
+ (This : in Spinner)
+ return Long_Float is
+ begin
+ return Long_Float (fl_spinner_get_step (This.Void_Ptr));
+ end Get_Step;
+
+
+ procedure Set_Step
+ (This : in out Spinner;
+ To : in Long_Float) is
+ begin
+ fl_spinner_set_step (This.Void_Ptr, Interfaces.C.double (To));
+ end Set_Step;
+
+
+ function Get_Value
+ (This : in Spinner)
+ return Long_Float is
+ begin
+ return Long_Float (fl_spinner_get_value (This.Void_Ptr));
+ end Get_Value;
+
+
+ procedure Set_Value
+ (This : in out Spinner;
+ To : in Long_Float) is
+ begin
+ fl_spinner_set_value (This.Void_Ptr, Interfaces.C.double (To));
+ end Set_Value;
+
+
+
+
+ function Get_Format
+ (This : in Spinner)
+ return String
+ is
+ Result : Interfaces.C.Strings.chars_ptr := fl_spinner_get_format (This.Void_Ptr);
+ begin
+ if Result = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Result);
+ end if;
+ end Get_Format;
+
+
+ procedure Set_Format
+ (This : in out Spinner;
+ To : in String) is
+ begin
+ Interfaces.C.Strings.Free (This.Format_Str);
+ This.Format_Str := Interfaces.C.Strings.New_String (To);
+ fl_spinner_set_format (This.Void_Ptr, This.Format_Str);
+ end Set_Format;
+
+
+ function Get_Kind
+ (This : in Spinner)
+ return Spinner_Kind
+ is
+ Result : Interfaces.C.unsigned_char := fl_spinner_get_type (This.Void_Ptr);
+ begin
+ return Spinner_Kind'Val (Result - 1);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Spinner::type returned unexpected unsigned char value of " &
+ Interfaces.C.unsigned_char'Image (Result);
+ end Get_Kind;
+
+
+ procedure Set_Kind
+ (This : in out Spinner;
+ To : in Spinner_Kind) is
+ begin
+ fl_spinner_set_type (This.Void_Ptr, Spinner_Kind'Pos (To) + 1);
+ end Set_Kind;
+
+
+
+
+ procedure Resize
+ (This : in out Spinner;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_spinner_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+
+
+ function Handle
+ (This : in out Spinner;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Group (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Groups.Spinners;
+
+
diff --git a/body/fltk-widgets-groups-tabbed.adb b/body/fltk-widgets-groups-tabbed.adb
new file mode 100644
index 0000000..360b824
--- /dev/null
+++ b/body/fltk-widgets-groups-tabbed.adb
@@ -0,0 +1,302 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Groups.Tabbed is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_tabs
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_tabs, "new_fl_tabs");
+ pragma Inline (new_fl_tabs);
+
+ procedure free_fl_tabs
+ (S : in Storage.Integer_Address);
+ pragma Import (C, free_fl_tabs, "free_fl_tabs");
+ pragma Inline (free_fl_tabs);
+
+
+
+
+ procedure fl_tabs_client_area
+ (T : in Storage.Integer_Address;
+ X, Y, W, H : out Interfaces.C.int;
+ I : in Interfaces.C.int);
+ pragma Import (C, fl_tabs_client_area, "fl_tabs_client_area");
+ pragma Inline (fl_tabs_client_area);
+
+
+
+
+ function fl_tabs_get_push
+ (T : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_tabs_get_push, "fl_tabs_get_push");
+ pragma Inline (fl_tabs_get_push);
+
+ procedure fl_tabs_set_push
+ (T, I : in Storage.Integer_Address);
+ pragma Import (C, fl_tabs_set_push, "fl_tabs_set_push");
+ pragma Inline (fl_tabs_set_push);
+
+ function fl_tabs_get_value
+ (T : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_tabs_get_value, "fl_tabs_get_value");
+ pragma Inline (fl_tabs_get_value);
+
+ procedure fl_tabs_set_value
+ (T, V : in Storage.Integer_Address);
+ pragma Import (C, fl_tabs_set_value, "fl_tabs_set_value");
+ pragma Inline (fl_tabs_set_value);
+
+ function fl_tabs_which
+ (T : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_tabs_which, "fl_tabs_which");
+ pragma Inline (fl_tabs_which);
+
+
+
+
+ procedure fl_tabs_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_tabs_draw, "fl_tabs_draw");
+ pragma Inline (fl_tabs_draw);
+
+ procedure fl_tabs_redraw_tabs
+ (T : in Storage.Integer_Address);
+ pragma Import (C, fl_tabs_redraw_tabs, "fl_tabs_redraw_tabs");
+ pragma Inline (fl_tabs_redraw_tabs);
+
+ function fl_tabs_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_tabs_handle, "fl_tabs_handle");
+ pragma Inline (fl_tabs_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Tabbed_Group) is
+ begin
+ Extra_Final (Group (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Tabbed_Group) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_tabs (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Tabbed_Group;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Tabbed_Group) is
+ begin
+ This.Draw_Ptr := fl_tabs_draw'Address;
+ This.Handle_Ptr := fl_tabs_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Tabbed_Group is
+ begin
+ return This : Tabbed_Group do
+ This.Void_Ptr := new_fl_tabs
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Tabbed_Group is
+ begin
+ return This : Tabbed_Group := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Get_Client_Area
+ (This : in Tabbed_Group;
+ Tab_Height : in Natural;
+ X, Y, W, H : out Integer) is
+ begin
+ fl_tabs_client_area
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Tab_Height));
+ end Get_Client_Area;
+
+
+
+
+ function Get_Push
+ (This : in Tabbed_Group)
+ return access Widget'Class
+ is
+ Push_Ptr : Storage.Integer_Address := fl_tabs_get_push (This.Void_Ptr);
+ Actual_Widget : access Widget'Class;
+ begin
+ if Push_Ptr /= Null_Pointer then
+ Push_Ptr := fl_widget_get_user_data (Push_Ptr);
+ pragma Assert (Push_Ptr /= Null_Pointer);
+ Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Push_Ptr));
+ end if;
+ return Actual_Widget;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Push;
+
+
+ procedure Set_Push
+ (This : in out Tabbed_Group;
+ Item : in out Widget'Class) is
+ begin
+ fl_tabs_set_push (This.Void_Ptr, Item.Void_Ptr);
+ end Set_Push;
+
+
+ function Get_Visible
+ (This : in Tabbed_Group)
+ return access Widget'Class
+ is
+ Visible_Ptr : Storage.Integer_Address := fl_tabs_get_value (This.Void_Ptr);
+ Actual_Widget : access Widget'Class;
+ begin
+ if Visible_Ptr /= Null_Pointer then
+ Visible_Ptr := fl_widget_get_user_data (Visible_Ptr);
+ pragma Assert (Visible_Ptr /= Null_Pointer);
+ Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Visible_Ptr));
+ end if;
+ return Actual_Widget;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Visible;
+
+
+ procedure Set_Visible
+ (This : in out Tabbed_Group;
+ Item : in out Widget'Class) is
+ begin
+ fl_tabs_set_value (This.Void_Ptr, Item.Void_Ptr);
+ end Set_Visible;
+
+
+ function Get_Which
+ (This : in Tabbed_Group;
+ Event_X, Event_Y : in Integer)
+ return access Widget'Class
+ is
+ Which_Ptr : Storage.Integer_Address :=
+ fl_tabs_which (This.Void_Ptr, Interfaces.C.int (Event_X), Interfaces.C.int (Event_Y));
+ Actual_Widget : access Widget'Class;
+ begin
+ if Which_Ptr /= Null_Pointer then
+ Which_Ptr := fl_widget_get_user_data (Which_Ptr);
+ pragma Assert (Which_Ptr /= Null_Pointer);
+ Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Which_Ptr));
+ end if;
+ return Actual_Widget;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Which;
+
+
+
+
+ procedure Draw
+ (This : in out Tabbed_Group) is
+ begin
+ Group (This).Draw;
+ end Draw;
+
+
+ procedure Redraw_Tabs
+ (This : in out Tabbed_Group) is
+ begin
+ fl_tabs_redraw_tabs (This.Void_Ptr);
+ end Redraw_Tabs;
+
+
+ function Handle
+ (This : in out Tabbed_Group;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Group (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Groups.Tabbed;
+
+
diff --git a/body/fltk-widgets-groups-text_displays-text_editors.adb b/body/fltk-widgets-groups-text_displays-text_editors.adb
new file mode 100644
index 0000000..15066f9
--- /dev/null
+++ b/body/fltk-widgets-groups-text_displays-text_editors.adb
@@ -0,0 +1,1232 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Ada.Characters.Latin_1,
+ FLTK.Event,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is
+
+
+ package Chk renames Ada.Assertions;
+ package Latin renames Ada.Characters.Latin_1;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_text_editor
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_text_editor, "new_fl_text_editor");
+ pragma Inline (new_fl_text_editor);
+
+ procedure free_fl_text_editor
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, free_fl_text_editor, "free_fl_text_editor");
+ pragma Inline (free_fl_text_editor);
+
+
+
+
+ procedure fl_text_editor_default
+ (TE : in Storage.Integer_Address;
+ K : in Interfaces.C.int);
+ pragma Import (C, fl_text_editor_default, "fl_text_editor_default");
+ pragma Inline (fl_text_editor_default);
+
+
+
+
+ procedure fl_text_editor_undo
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_undo, "fl_text_editor_undo");
+ pragma Inline (fl_text_editor_undo);
+
+ procedure fl_text_editor_cut
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_cut, "fl_text_editor_cut");
+ pragma Inline (fl_text_editor_cut);
+
+ procedure fl_text_editor_copy
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_copy, "fl_text_editor_copy");
+ pragma Inline (fl_text_editor_copy);
+
+ procedure fl_text_editor_paste
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_paste, "fl_text_editor_paste");
+ pragma Inline (fl_text_editor_paste);
+
+ procedure fl_text_editor_delete
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_delete, "fl_text_editor_delete");
+ pragma Inline (fl_text_editor_delete);
+
+ procedure fl_text_editor_select_all
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_select_all, "fl_text_editor_select_all");
+ pragma Inline (fl_text_editor_select_all);
+
+
+
+
+ procedure fl_text_editor_backspace
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_backspace, "fl_text_editor_backspace");
+ pragma Inline (fl_text_editor_backspace);
+
+ procedure fl_text_editor_insert
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_insert, "fl_text_editor_insert");
+ pragma Inline (fl_text_editor_insert);
+
+ procedure fl_text_editor_enter
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_enter, "fl_text_editor_enter");
+ pragma Inline (fl_text_editor_enter);
+
+ procedure fl_text_editor_ignore
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ignore, "fl_text_editor_ignore");
+ pragma Inline (fl_text_editor_ignore);
+
+
+
+
+ procedure fl_text_editor_home
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_home, "fl_text_editor_home");
+ pragma Inline (fl_text_editor_home);
+
+ procedure fl_text_editor_end
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_end, "fl_text_editor_end");
+ pragma Inline (fl_text_editor_end);
+
+ procedure fl_text_editor_page_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_page_down, "fl_text_editor_page_down");
+ pragma Inline (fl_text_editor_page_down);
+
+ procedure fl_text_editor_page_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_page_up, "fl_text_editor_page_up");
+ pragma Inline (fl_text_editor_page_up);
+
+ procedure fl_text_editor_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_down, "fl_text_editor_down");
+ pragma Inline (fl_text_editor_down);
+
+ procedure fl_text_editor_left
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_left, "fl_text_editor_left");
+ pragma Inline (fl_text_editor_left);
+
+ procedure fl_text_editor_right
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_right, "fl_text_editor_right");
+ pragma Inline (fl_text_editor_right);
+
+ procedure fl_text_editor_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_up, "fl_text_editor_up");
+ pragma Inline (fl_text_editor_up);
+
+
+
+
+ procedure fl_text_editor_shift_home
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_shift_home, "fl_text_editor_shift_home");
+ pragma Inline (fl_text_editor_shift_home);
+
+ procedure fl_text_editor_shift_end
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_shift_end, "fl_text_editor_shift_end");
+ pragma Inline (fl_text_editor_shift_end);
+
+ procedure fl_text_editor_shift_page_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_shift_page_down, "fl_text_editor_shift_page_down");
+ pragma Inline (fl_text_editor_shift_page_down);
+
+ procedure fl_text_editor_shift_page_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_shift_page_up, "fl_text_editor_shift_page_up");
+ pragma Inline (fl_text_editor_shift_page_up);
+
+ procedure fl_text_editor_shift_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_shift_down, "fl_text_editor_shift_down");
+ pragma Inline (fl_text_editor_shift_down);
+
+ procedure fl_text_editor_shift_left
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_shift_left, "fl_text_editor_shift_left");
+ pragma Inline (fl_text_editor_shift_left);
+
+ procedure fl_text_editor_shift_right
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_shift_right, "fl_text_editor_shift_right");
+ pragma Inline (fl_text_editor_shift_right);
+
+ procedure fl_text_editor_shift_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_shift_up, "fl_text_editor_shift_up");
+ pragma Inline (fl_text_editor_shift_up);
+
+
+
+
+ procedure fl_text_editor_ctrl_home
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_home, "fl_text_editor_ctrl_home");
+ pragma Inline (fl_text_editor_ctrl_home);
+
+ procedure fl_text_editor_ctrl_end
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_end, "fl_text_editor_ctrl_end");
+ pragma Inline (fl_text_editor_ctrl_end);
+
+ procedure fl_text_editor_ctrl_page_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_page_down, "fl_text_editor_ctrl_page_down");
+ pragma Inline (fl_text_editor_ctrl_page_down);
+
+ procedure fl_text_editor_ctrl_page_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_page_up, "fl_text_editor_ctrl_page_up");
+ pragma Inline (fl_text_editor_ctrl_page_up);
+
+ procedure fl_text_editor_ctrl_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_down, "fl_text_editor_ctrl_down");
+ pragma Inline (fl_text_editor_ctrl_down);
+
+ procedure fl_text_editor_ctrl_left
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_left, "fl_text_editor_ctrl_left");
+ pragma Inline (fl_text_editor_ctrl_left);
+
+ procedure fl_text_editor_ctrl_right
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_right, "fl_text_editor_ctrl_right");
+ pragma Inline (fl_text_editor_ctrl_right);
+
+ procedure fl_text_editor_ctrl_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_up, "fl_text_editor_ctrl_up");
+ pragma Inline (fl_text_editor_ctrl_up);
+
+
+
+
+ procedure fl_text_editor_ctrl_shift_home
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_shift_home, "fl_text_editor_ctrl_shift_home");
+ pragma Inline (fl_text_editor_ctrl_shift_home);
+
+ procedure fl_text_editor_ctrl_shift_end
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_shift_end, "fl_text_editor_ctrl_shift_end");
+ pragma Inline (fl_text_editor_ctrl_shift_end);
+
+ procedure fl_text_editor_ctrl_shift_page_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_shift_page_down, "fl_text_editor_ctrl_shift_page_down");
+ pragma Inline (fl_text_editor_ctrl_shift_page_down);
+
+ procedure fl_text_editor_ctrl_shift_page_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_shift_page_up, "fl_text_editor_ctrl_shift_page_up");
+ pragma Inline (fl_text_editor_ctrl_shift_page_up);
+
+ procedure fl_text_editor_ctrl_shift_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_shift_down, "fl_text_editor_ctrl_shift_down");
+ pragma Inline (fl_text_editor_ctrl_shift_down);
+
+ procedure fl_text_editor_ctrl_shift_left
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_shift_left, "fl_text_editor_ctrl_shift_left");
+ pragma Inline (fl_text_editor_ctrl_shift_left);
+
+ procedure fl_text_editor_ctrl_shift_right
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_shift_right, "fl_text_editor_ctrl_shift_right");
+ pragma Inline (fl_text_editor_ctrl_shift_right);
+
+ procedure fl_text_editor_ctrl_shift_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_ctrl_shift_up, "fl_text_editor_ctrl_shift_up");
+ pragma Inline (fl_text_editor_ctrl_shift_up);
+
+
+
+
+ procedure fl_text_editor_meta_home
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_home, "fl_text_editor_meta_home");
+ pragma Inline (fl_text_editor_meta_home);
+
+ procedure fl_text_editor_meta_end
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_end, "fl_text_editor_meta_end");
+ pragma Inline (fl_text_editor_meta_end);
+
+ procedure fl_text_editor_meta_page_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_page_down, "fl_text_editor_meta_page_down");
+ pragma Inline (fl_text_editor_meta_page_down);
+
+ procedure fl_text_editor_meta_page_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_page_up, "fl_text_editor_meta_page_up");
+ pragma Inline (fl_text_editor_meta_page_up);
+
+ procedure fl_text_editor_meta_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_down, "fl_text_editor_meta_down");
+ pragma Inline (fl_text_editor_meta_down);
+
+ procedure fl_text_editor_meta_left
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_left, "fl_text_editor_meta_left");
+ pragma Inline (fl_text_editor_meta_left);
+
+ procedure fl_text_editor_meta_right
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_right, "fl_text_editor_meta_right");
+ pragma Inline (fl_text_editor_meta_right);
+
+ procedure fl_text_editor_meta_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_up, "fl_text_editor_meta_up");
+ pragma Inline (fl_text_editor_meta_up);
+
+
+
+
+ procedure fl_text_editor_meta_shift_home
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_shift_home, "fl_text_editor_meta_shift_home");
+ pragma Inline (fl_text_editor_meta_shift_home);
+
+ procedure fl_text_editor_meta_shift_end
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_shift_end, "fl_text_editor_meta_shift_end");
+ pragma Inline (fl_text_editor_meta_shift_end);
+
+ procedure fl_text_editor_meta_shift_page_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_shift_page_down, "fl_text_editor_meta_shift_page_down");
+ pragma Inline (fl_text_editor_meta_shift_page_down);
+
+ procedure fl_text_editor_meta_shift_page_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_shift_page_up, "fl_text_editor_meta_shift_page_up");
+ pragma Inline (fl_text_editor_meta_shift_page_up);
+
+ procedure fl_text_editor_meta_shift_down
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_shift_down, "fl_text_editor_meta_shift_down");
+ pragma Inline (fl_text_editor_meta_shift_down);
+
+ procedure fl_text_editor_meta_shift_left
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_shift_left, "fl_text_editor_meta_shift_left");
+ pragma Inline (fl_text_editor_meta_shift_left);
+
+ procedure fl_text_editor_meta_shift_right
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_shift_right, "fl_text_editor_meta_shift_right");
+ pragma Inline (fl_text_editor_meta_shift_right);
+
+ procedure fl_text_editor_meta_shift_up
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_meta_shift_up, "fl_text_editor_meta_shift_up");
+ pragma Inline (fl_text_editor_meta_shift_up);
+
+
+
+
+ procedure fl_text_editor_add_key_binding
+ (TE : in Storage.Integer_Address;
+ K, S : in Interfaces.C.int;
+ F : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_add_key_binding, "fl_text_editor_add_key_binding");
+ pragma Inline (fl_text_editor_add_key_binding);
+
+ procedure fl_text_editor_remove_all_key_bindings
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_remove_all_key_bindings,
+ "fl_text_editor_remove_all_key_bindings");
+ pragma Inline (fl_text_editor_remove_all_key_bindings);
+
+ procedure fl_text_editor_set_default_key_function
+ (TE, F : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_set_default_key_function,
+ "fl_text_editor_set_default_key_function");
+ pragma Inline (fl_text_editor_set_default_key_function);
+
+
+
+
+ function fl_text_editor_get_insert_mode
+ (TE : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_editor_get_insert_mode, "fl_text_editor_get_insert_mode");
+ pragma Inline (fl_text_editor_get_insert_mode);
+
+ procedure fl_text_editor_set_insert_mode
+ (TE : in Storage.Integer_Address;
+ I : in Interfaces.C.int);
+ pragma Import (C, fl_text_editor_set_insert_mode, "fl_text_editor_set_insert_mode");
+ pragma Inline (fl_text_editor_set_insert_mode);
+
+
+
+
+ function fl_text_editor_get_tab_nav
+ (TE : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_editor_get_tab_nav, "fl_text_editor_get_tab_nav");
+ pragma Inline (fl_text_editor_get_tab_nav);
+
+ procedure fl_text_editor_set_tab_nav
+ (TE : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_text_editor_set_tab_nav, "fl_text_editor_set_tab_nav");
+ pragma Inline (fl_text_editor_set_tab_nav);
+
+
+
+
+ procedure fl_text_editor_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_draw, "fl_text_editor_draw");
+ pragma Inline (fl_text_editor_draw);
+
+ function fl_text_editor_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_editor_handle, "fl_text_editor_handle");
+ pragma Inline (fl_text_editor_handle);
+
+ function fl_text_editor_handle_key
+ (TE : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_editor_handle_key, "fl_text_editor_handle_key");
+ pragma Inline (fl_text_editor_handle_key);
+
+ procedure fl_text_editor_maybe_do_callback
+ (TE : in Storage.Integer_Address);
+ pragma Import (C, fl_text_editor_maybe_do_callback, "fl_text_editor_maybe_do_callback");
+ pragma Inline (fl_text_editor_maybe_do_callback);
+
+
+
+
+ ----------------------
+ -- Callback Hooks --
+ ----------------------
+
+ function Key_Func_Hook
+ (K : in Interfaces.C.int;
+ E : in Storage.Integer_Address)
+ return Interfaces.C.int
+ is
+ Editor_Ptr : Storage.Integer_Address := fl_widget_get_user_data (E);
+ Ada_Editor : access Text_Editor'Class;
+
+ Extra_Keys : Modifier := FLTK.Event.Last_Modifier;
+ Actual_Key : Keypress := FLTK.Event.Last_Key; -- fuck you FLTK, give me the real code
+ Ada_Key : Key_Combo := Extra_Keys + Actual_Key;
+
+ -- For whatever reason, if a regular key function is used then FLTK will
+ -- give you the key code, but if a default key function is used instead it
+ -- will give you the first character in the textual representation, which
+ -- is not ideal. This is why we have to grab the Last_Key manually.
+ begin
+ pragma Assert (Editor_Ptr /= Null_Pointer);
+ Ada_Editor := Editor_Convert.To_Pointer (Storage.To_Address (Editor_Ptr));
+ for B of Global_Key_Bindings loop
+ if B.Key = Ada_Key and B.Func /= null then
+ B.Func (Ada_Editor.all);
+ return Event_Outcome'Pos (Handled);
+ end if;
+ end loop;
+ for B of Ada_Editor.Bindings loop
+ if B.Key = Ada_Key then
+ B.Func (Ada_Editor.all);
+ return Event_Outcome'Pos (Handled);
+ end if;
+ end loop;
+ if Ada_Editor.Default_Func /= null then
+ Ada_Editor.Default_Func (Ada_Editor.all, Ada_Key);
+ return Event_Outcome'Pos (Handled);
+ end if;
+ return Event_Outcome'Pos (Not_Handled);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error with
+ "Fl_Text_Editor C++ object had no user data reference back to the " &
+ "corresponding Ada object in the Key_Func hook";
+ end Key_Func_Hook;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Text_Editor) is
+ begin
+ Extra_Final (Text_Display (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Text_Editor) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_text_editor (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ if This.Raw_Buffer /= Null_Pointer then
+ free_fl_text_buffer (This.Raw_Buffer); -- buffer is reference counted
+ This.Raw_Buffer := Null_Pointer;
+ end if;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Text_Editor;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ for B of Default_Key_Bindings loop
+ This.Bindings.Append (B);
+ end loop;
+ This.Default_Func := KF_Default'Access;
+
+ -- change things over so key bindings are all handled from the Ada side
+ fl_text_editor_remove_all_key_bindings (This.Void_Ptr);
+ fl_text_editor_set_default_key_function
+ (This.Void_Ptr, Storage.To_Integer (Key_Func_Hook'Address));
+
+ Extra_Init (Text_Display (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Text_Editor) is
+ begin
+ This.Draw_Ptr := fl_text_editor_draw'Address;
+ This.Handle_Ptr := fl_text_editor_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Text_Editor
+ is
+ use type Interfaces.C.int;
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Text_Editor is
+ begin
+ return This : Text_Editor := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure KF_Default
+ (This : in out Text_Editor'Class;
+ Key : in Key_Combo) is
+ begin
+ fl_text_editor_default
+ (This.Void_Ptr,
+ Interfaces.C.int (Key.Keycode));
+ end KF_Default;
+
+
+
+
+ procedure KF_Undo
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_undo (This.Void_Ptr);
+ end KF_Undo;
+
+
+ procedure KF_Cut
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_cut (This.Void_Ptr);
+ end KF_Cut;
+
+
+ procedure KF_Copy
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_copy (This.Void_Ptr);
+ end KF_Copy;
+
+
+ procedure KF_Paste
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_paste (This.Void_Ptr);
+ end KF_Paste;
+
+
+ procedure KF_Delete
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_delete (This.Void_Ptr);
+ end KF_Delete;
+
+
+ procedure KF_Select_All
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_select_all (This.Void_Ptr);
+ end KF_Select_All;
+
+
+
+
+ procedure KF_Backspace
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_backspace (This.Void_Ptr);
+ end KF_Backspace;
+
+
+ procedure KF_Insert
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_insert (This.Void_Ptr);
+ end KF_Insert;
+
+
+ procedure KF_Enter
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_enter (This.Void_Ptr);
+ end KF_Enter;
+
+
+ procedure KF_Ignore
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ignore (This.Void_Ptr);
+ end KF_Ignore;
+
+
+ procedure KF_Tab
+ (This : in out Text_Editor'Class) is
+ begin
+ This.Insert_Text (Latin.HT & "");
+ end KF_Tab;
+
+
+
+
+ procedure KF_Home
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_home (This.Void_Ptr);
+ end KF_Home;
+
+
+ procedure KF_End
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_end (This.Void_Ptr);
+ end KF_End;
+
+
+ procedure KF_Page_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_page_down (This.Void_Ptr);
+ end KF_Page_Down;
+
+
+ procedure KF_Page_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_page_up (This.Void_Ptr);
+ end KF_Page_Up;
+
+
+ procedure KF_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_down (This.Void_Ptr);
+ end KF_Down;
+
+
+ procedure KF_Left
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_left (This.Void_Ptr);
+ end KF_Left;
+
+
+ procedure KF_Right
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_right (This.Void_Ptr);
+ end KF_Right;
+
+
+ procedure KF_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_up (This.Void_Ptr);
+ end KF_Up;
+
+
+
+
+ procedure KF_Shift_Home
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_shift_home (This.Void_Ptr);
+ end KF_Shift_Home;
+
+
+ procedure KF_Shift_End
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_shift_end (This.Void_Ptr);
+ end KF_Shift_End;
+
+
+ procedure KF_Shift_Page_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_shift_page_down (This.Void_Ptr);
+ end KF_Shift_Page_Down;
+
+
+ procedure KF_Shift_Page_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_shift_page_up (This.Void_Ptr);
+ end KF_Shift_Page_Up;
+
+
+ procedure KF_Shift_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_shift_down (This.Void_Ptr);
+ end KF_Shift_Down;
+
+
+ procedure KF_Shift_Left
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_shift_left (This.Void_Ptr);
+ end KF_Shift_Left;
+
+
+ procedure KF_Shift_Right
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_shift_right (This.Void_Ptr);
+ end KF_Shift_Right;
+
+
+ procedure KF_Shift_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_shift_up (This.Void_Ptr);
+ end KF_Shift_Up;
+
+
+
+
+ procedure KF_Ctrl_Home
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_home (This.Void_Ptr);
+ end KF_Ctrl_Home;
+
+
+ procedure KF_Ctrl_End
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_end (This.Void_Ptr);
+ end KF_Ctrl_End;
+
+
+ procedure KF_Ctrl_Page_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_page_down (This.Void_Ptr);
+ end KF_Ctrl_Page_Down;
+
+
+ procedure KF_Ctrl_Page_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_page_up (This.Void_Ptr);
+ end KF_Ctrl_Page_Up;
+
+
+ procedure KF_Ctrl_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_down (This.Void_Ptr);
+ end KF_Ctrl_Down;
+
+
+ procedure KF_Ctrl_Left
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_left (This.Void_Ptr);
+ end KF_Ctrl_Left;
+
+
+ procedure KF_Ctrl_Right
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_right (This.Void_Ptr);
+ end KF_Ctrl_Right;
+
+
+ procedure KF_Ctrl_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_up (This.Void_Ptr);
+ end KF_Ctrl_Up;
+
+
+
+
+ procedure KF_Ctrl_Shift_Home
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_shift_home (This.Void_Ptr);
+ end KF_Ctrl_Shift_Home;
+
+
+ procedure KF_Ctrl_Shift_End
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_shift_end (This.Void_Ptr);
+ end KF_Ctrl_Shift_End;
+
+
+ procedure KF_Ctrl_Shift_Page_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_shift_page_down (This.Void_Ptr);
+ end KF_Ctrl_Shift_Page_Down;
+
+
+ procedure KF_Ctrl_Shift_Page_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_shift_page_up (This.Void_Ptr);
+ end KF_Ctrl_Shift_Page_Up;
+
+
+ procedure KF_Ctrl_Shift_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_shift_down (This.Void_Ptr);
+ end KF_Ctrl_Shift_Down;
+
+
+ procedure KF_Ctrl_Shift_Left
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_shift_left (This.Void_Ptr);
+ end KF_Ctrl_Shift_Left;
+
+
+ procedure KF_Ctrl_Shift_Right
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_shift_right (This.Void_Ptr);
+ end KF_Ctrl_Shift_Right;
+
+
+ procedure KF_Ctrl_Shift_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_ctrl_shift_up (This.Void_Ptr);
+ end KF_Ctrl_Shift_Up;
+
+
+
+
+ procedure KF_Meta_Home
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_home (This.Void_Ptr);
+ end KF_Meta_Home;
+
+
+ procedure KF_Meta_End
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_end (This.Void_Ptr);
+ end KF_Meta_End;
+
+
+ procedure KF_Meta_Page_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_page_down (This.Void_Ptr);
+ end KF_Meta_Page_Down;
+
+
+ procedure KF_Meta_Page_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_page_up (This.Void_Ptr);
+ end KF_Meta_Page_Up;
+
+
+ procedure KF_Meta_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_down (This.Void_Ptr);
+ end KF_Meta_Down;
+
+
+ procedure KF_Meta_Left
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_left (This.Void_Ptr);
+ end KF_Meta_Left;
+
+
+ procedure KF_Meta_Right
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_right (This.Void_Ptr);
+ end KF_Meta_Right;
+
+
+ procedure KF_Meta_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_up (This.Void_Ptr);
+ end KF_Meta_Up;
+
+
+
+
+ procedure KF_Meta_Shift_Home
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_shift_home (This.Void_Ptr);
+ end KF_Meta_Shift_Home;
+
+
+ procedure KF_Meta_Shift_End
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_shift_end (This.Void_Ptr);
+ end KF_Meta_Shift_End;
+
+
+ procedure KF_Meta_Shift_Page_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_shift_page_down (This.Void_Ptr);
+ end KF_Meta_Shift_Page_Down;
+
+
+ procedure KF_Meta_Shift_Page_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_shift_page_up (This.Void_Ptr);
+ end KF_Meta_Shift_Page_Up;
+
+
+ procedure KF_Meta_Shift_Down
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_shift_down (This.Void_Ptr);
+ end KF_Meta_Shift_Down;
+
+
+ procedure KF_Meta_Shift_Left
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_shift_left (This.Void_Ptr);
+ end KF_Meta_Shift_Left;
+
+
+ procedure KF_Meta_Shift_Right
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_shift_right (This.Void_Ptr);
+ end KF_Meta_Shift_Right;
+
+
+ procedure KF_Meta_Shift_Up
+ (This : in out Text_Editor'Class) is
+ begin
+ fl_text_editor_meta_shift_up (This.Void_Ptr);
+ end KF_Meta_Shift_Up;
+
+
+
+
+ procedure Add_Key_Binding
+ (This : in out Text_Editor;
+ Key : in Key_Combo;
+ Func : in Key_Func) is
+ begin
+ if Func /= null then
+ This.Bindings.Append ((Key, Func));
+ end if;
+ end Add_Key_Binding;
+
+
+ procedure Add_Key_Binding
+ (This : in out Text_Editor;
+ Bind : in Key_Binding) is
+ begin
+ if Bind.Func /= null then
+ This.Bindings.Append (Bind);
+ end if;
+ end Add_Key_Binding;
+
+
+ procedure Add_Key_Bindings
+ (This : in out Text_Editor;
+ Bind : in Key_Binding_Array) is
+ begin
+ for Item of Bind loop
+ if Item.Func /= null then
+ This.Bindings.Append (Item);
+ end if;
+ end loop;
+ end Add_Key_Bindings;
+
+
+ function Get_Bound_Key_Function
+ (This : in Text_Editor;
+ Key : in Key_Combo)
+ return Key_Func is
+ begin
+ for I in 1 .. Integer (This.Bindings.Length) loop
+ if This.Bindings.Element (I).Key = Key then
+ return This.Bindings.Element (I).Func;
+ end if;
+ end loop;
+ return null;
+ end Get_Bound_Key_Function;
+
+
+ function Get_All_Bound_Key_Functions
+ (This : in Text_Editor)
+ return Key_Binding_Array is
+ begin
+ return Result : Key_Binding_Array (1 .. Integer (This.Bindings.Length)) do
+ for Place in Result'Range loop
+ Result (Place) := This.Bindings.Element (Place);
+ end loop;
+ end return;
+ end Get_All_Bound_Key_Functions;
+
+
+ procedure Remove_Key_Binding
+ (This : in out Text_Editor;
+ Key : in Key_Combo) is
+ begin
+ for I in reverse 1 .. Integer (This.Bindings.Length) loop
+ if This.Bindings.Element (I).Key = Key then
+ This.Bindings.Delete (I);
+ end if;
+ end loop;
+ end Remove_Key_Binding;
+
+
+ procedure Remove_Key_Binding
+ (This : in out Text_Editor;
+ Bind : in Key_Binding) is
+ begin
+ for I in reverse 1 .. Integer (This.Bindings.Length) loop
+ if This.Bindings.Element (I) = Bind then
+ This.Bindings.Delete (I);
+ end if;
+ end loop;
+ end Remove_Key_Binding;
+
+
+ procedure Remove_Key_Bindings
+ (This : in out Text_Editor;
+ Bind : in Key_Binding_Array) is
+ begin
+ for Item of Bind loop
+ This.Remove_Key_Binding (Item);
+ end loop;
+ end Remove_Key_Bindings;
+
+
+ procedure Remove_All_Key_Bindings
+ (This : in out Text_Editor) is
+ begin
+ This.Bindings.Clear;
+ end Remove_All_Key_Bindings;
+
+
+ function Get_Default_Key_Function
+ (This : in Text_Editor)
+ return Default_Key_Func is
+ begin
+ return This.Default_Func;
+ end Get_Default_Key_Function;
+
+
+ procedure Set_Default_Key_Function
+ (This : in out Text_Editor;
+ Func : in Default_Key_Func) is
+ begin
+ This.Default_Func := Func;
+ end Set_Default_Key_Function;
+
+
+
+
+ function Get_Insert_Mode
+ (This : in Text_Editor)
+ return Insert_Mode
+ is
+ Result : Interfaces.C.int := fl_text_editor_get_insert_mode (This.Void_Ptr);
+ begin
+ return Insert_Mode'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Text_Editor::insert_mode returned unexpected int value of " &
+ Interfaces.C.int'Image (Result);
+ end Get_Insert_Mode;
+
+
+ procedure Set_Insert_Mode
+ (This : in out Text_Editor;
+ To : in Insert_Mode) is
+ begin
+ fl_text_editor_set_insert_mode (This.Void_Ptr, Insert_Mode'Pos (To));
+ end Set_Insert_Mode;
+
+
+
+
+ function Get_Tab_Mode
+ (This : in Text_Editor)
+ return Tab_Navigation
+ is
+ Result : Interfaces.C.int := fl_text_editor_get_tab_nav (This.Void_Ptr);
+ begin
+ return Tab_Navigation'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Text_Editor::tab_nav returned unexpected int value of " &
+ Interfaces.C.int'Image (Result);
+ end Get_Tab_Mode;
+
+
+ procedure Set_Tab_Mode
+ (This : in out Text_Editor;
+ To : in Tab_Navigation) is
+ begin
+ fl_text_editor_set_tab_nav (This.Void_Ptr, Tab_Navigation'Pos (To));
+ end Set_Tab_Mode;
+
+
+
+
+ function Handle
+ (This : in out Text_Editor;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Text_Display (This).Handle (Event);
+ end Handle;
+
+
+ function Handle_Key
+ (This : in out Text_Editor)
+ return Event_Outcome
+ is
+ Result : Interfaces.C.int := fl_text_editor_handle_key (This.Void_Ptr);
+ begin
+ return Event_Outcome'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Text_Editor::handle_key returned unexpected int value of " &
+ Interfaces.C.int'Image (Result);
+ end Handle_Key;
+
+
+ procedure Maybe_Do_Callback
+ (This : in out Text_Editor) is
+ begin
+ fl_text_editor_maybe_do_callback (This.Void_Ptr);
+ end Maybe_Do_Callback;
+
+
+end FLTK.Widgets.Groups.Text_Displays.Text_Editors;
+
+
diff --git a/body/fltk-widgets-groups-text_displays.adb b/body/fltk-widgets-groups-text_displays.adb
new file mode 100644
index 0000000..011d841
--- /dev/null
+++ b/body/fltk-widgets-groups-text_displays.adb
@@ -0,0 +1,1153 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C,
+ FLTK.Text_Buffers;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Groups.Text_Displays is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_text_display
+ (X, Y, W, H : in Interfaces.C.int;
+ Label : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_text_display, "new_fl_text_display");
+ pragma Inline (new_fl_text_display);
+
+ procedure free_fl_text_display
+ (TD : in Storage.Integer_Address);
+ pragma Import (C, free_fl_text_display, "free_fl_text_display");
+ pragma Inline (free_fl_text_display);
+
+
+
+
+ function fl_text_display_get_buffer
+ (TD : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_text_display_get_buffer, "fl_text_display_get_buffer");
+ pragma Inline (fl_text_display_get_buffer);
+
+ procedure fl_text_display_set_buffer
+ (TD, TB : in Storage.Integer_Address);
+ pragma Import (C, fl_text_display_set_buffer, "fl_text_display_set_buffer");
+ pragma Inline (fl_text_display_set_buffer);
+
+
+
+
+ procedure fl_text_display_highlight_data
+ (TD, TB, ST : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_highlight_data, "fl_text_display_highlight_data");
+ pragma Inline (fl_text_display_highlight_data);
+
+ procedure fl_text_display_highlight_data2
+ (TD, TB, ST : in Storage.Integer_Address;
+ L : in Interfaces.C.int;
+ C : in Interfaces.C.unsigned;
+ B, A : in Storage.Integer_Address);
+ pragma Import (C, fl_text_display_highlight_data2, "fl_text_display_highlight_data2");
+ pragma Inline (fl_text_display_highlight_data2);
+
+
+
+
+ function fl_text_display_col_to_x
+ (TD : in Storage.Integer_Address;
+ C : in Interfaces.C.double)
+ return Interfaces.C.double;
+ pragma Import (C, fl_text_display_col_to_x, "fl_text_display_col_to_x");
+ pragma Inline (fl_text_display_col_to_x);
+
+ function fl_text_display_x_to_col
+ (TD : in Storage.Integer_Address;
+ X : in Interfaces.C.double)
+ return Interfaces.C.double;
+ pragma Import (C, fl_text_display_x_to_col, "fl_text_display_x_to_col");
+ pragma Inline (fl_text_display_x_to_col);
+
+ function fl_text_display_in_selection
+ (TD : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_in_selection, "fl_text_display_in_selection");
+ pragma Inline (fl_text_display_in_selection);
+
+ function fl_text_display_position_to_xy
+ (TD : in Storage.Integer_Address;
+ P : in Interfaces.C.int;
+ X, Y : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_position_to_xy, "fl_text_display_position_to_xy");
+ pragma Inline (fl_text_display_position_to_xy);
+
+
+
+
+ function fl_text_display_get_cursor_color
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_text_display_get_cursor_color, "fl_text_display_get_cursor_color");
+ pragma Inline (fl_text_display_get_cursor_color);
+
+ procedure fl_text_display_set_cursor_color
+ (TD : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_text_display_set_cursor_color, "fl_text_display_set_cursor_color");
+ pragma Inline (fl_text_display_set_cursor_color);
+
+ procedure fl_text_display_set_cursor_style
+ (TD : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_set_cursor_style, "fl_text_display_set_cursor_style");
+ pragma Inline (fl_text_display_set_cursor_style);
+
+ procedure fl_text_display_hide_cursor
+ (TD : in Storage.Integer_Address);
+ pragma Import (C, fl_text_display_hide_cursor, "fl_text_display_hide_cursor");
+ pragma Inline (fl_text_display_hide_cursor);
+
+ procedure fl_text_display_show_cursor
+ (TD : in Storage.Integer_Address);
+ pragma Import (C, fl_text_display_show_cursor, "fl_text_display_show_cursor");
+ pragma Inline (fl_text_display_show_cursor);
+
+
+
+
+ function fl_text_display_get_text_color
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_text_display_get_text_color, "fl_text_display_get_text_color");
+ pragma Inline (fl_text_display_get_text_color);
+
+ procedure fl_text_display_set_text_color
+ (TD : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_text_display_set_text_color, "fl_text_display_set_text_color");
+ pragma Inline (fl_text_display_set_text_color);
+
+ function fl_text_display_get_text_font
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_get_text_font, "fl_text_display_get_text_font");
+ pragma Inline (fl_text_display_get_text_font);
+
+ procedure fl_text_display_set_text_font
+ (TD : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_set_text_font, "fl_text_display_set_text_font");
+ pragma Inline (fl_text_display_set_text_font);
+
+ function fl_text_display_get_text_size
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_get_text_size, "fl_text_display_get_text_size");
+ pragma Inline (fl_text_display_get_text_size);
+
+ procedure fl_text_display_set_text_size
+ (TD : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_set_text_size, "fl_text_display_set_text_size");
+ pragma Inline (fl_text_display_set_text_size);
+
+
+
+
+ procedure fl_text_display_insert
+ (TD : in Storage.Integer_Address;
+ I : in Interfaces.C.char_array);
+ pragma Import (C, fl_text_display_insert, "fl_text_display_insert");
+ pragma Inline (fl_text_display_insert);
+
+ procedure fl_text_display_overstrike
+ (TD : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_text_display_overstrike, "fl_text_display_overstrike");
+ pragma Inline (fl_text_display_overstrike);
+
+ function fl_text_display_get_insert_pos
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_get_insert_pos, "fl_text_display_get_insert_pos");
+ pragma Inline (fl_text_display_get_insert_pos);
+
+ procedure fl_text_display_set_insert_pos
+ (TD : in Storage.Integer_Address;
+ P : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_set_insert_pos, "fl_text_display_set_insert_pos");
+ pragma Inline (fl_text_display_set_insert_pos);
+
+ procedure fl_text_display_show_insert_pos
+ (TD : in Storage.Integer_Address);
+ pragma Import (C, fl_text_display_show_insert_pos, "fl_text_display_show_insert_pos");
+ pragma Inline (fl_text_display_show_insert_pos);
+
+
+
+
+ function fl_text_display_word_start
+ (TD : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_word_start, "fl_text_display_word_start");
+ pragma Inline (fl_text_display_word_start);
+
+ function fl_text_display_word_end
+ (TD : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_word_end, "fl_text_display_word_end");
+ pragma Inline (fl_text_display_word_end);
+
+ procedure fl_text_display_next_word
+ (TD : in Storage.Integer_Address);
+ pragma Import (C, fl_text_display_next_word, "fl_text_display_next_word");
+ pragma Inline (fl_text_display_next_word);
+
+ procedure fl_text_display_previous_word
+ (TD : in Storage.Integer_Address);
+ pragma Import (C, fl_text_display_previous_word, "fl_text_display_previous_word");
+ pragma Inline (fl_text_display_previous_word);
+
+ procedure fl_text_display_wrap_mode
+ (TD : in Storage.Integer_Address;
+ W, M : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_wrap_mode, "fl_text_display_wrap_mode");
+ pragma Inline (fl_text_display_wrap_mode);
+
+
+
+
+ function fl_text_display_line_start
+ (TD : in Storage.Integer_Address;
+ S : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_line_start, "fl_text_display_line_start");
+ pragma Inline (fl_text_display_line_start);
+
+ function fl_text_display_line_end
+ (TD : in Storage.Integer_Address;
+ S, P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_line_end, "fl_text_display_line_end");
+ pragma Inline (fl_text_display_line_end);
+
+ function fl_text_display_count_lines
+ (TD : in Storage.Integer_Address;
+ S, F, P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_count_lines, "fl_text_display_count_lines");
+ pragma Inline (fl_text_display_count_lines);
+
+ function fl_text_display_skip_lines
+ (TD : in Storage.Integer_Address;
+ S, L, P : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_skip_lines, "fl_text_display_skip_lines");
+ pragma Inline (fl_text_display_skip_lines);
+
+ function fl_text_display_rewind_lines
+ (TD : in Storage.Integer_Address;
+ S, L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_rewind_lines, "fl_text_display_rewind_lines");
+ pragma Inline (fl_text_display_rewind_lines);
+
+
+
+
+ function fl_text_display_get_linenumber_align
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_text_display_get_linenumber_align,
+ "fl_text_display_get_linenumber_align");
+ pragma Inline (fl_text_display_get_linenumber_align);
+
+ procedure fl_text_display_set_linenumber_align
+ (TD : in Storage.Integer_Address;
+ A : in Interfaces.C.unsigned);
+ pragma Import (C, fl_text_display_set_linenumber_align,
+ "fl_text_display_set_linenumber_align");
+ pragma Inline (fl_text_display_set_linenumber_align);
+
+ function fl_text_display_get_linenumber_bgcolor
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_text_display_get_linenumber_bgcolor,
+ "fl_text_display_get_linenumber_bgcolor");
+ pragma Inline (fl_text_display_get_linenumber_bgcolor);
+
+ procedure fl_text_display_set_linenumber_bgcolor
+ (TD : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_text_display_set_linenumber_bgcolor,
+ "fl_text_display_set_linenumber_bgcolor");
+ pragma Inline (fl_text_display_set_linenumber_bgcolor);
+
+ function fl_text_display_get_linenumber_fgcolor
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_text_display_get_linenumber_fgcolor,
+ "fl_text_display_get_linenumber_fgcolor");
+ pragma Inline (fl_text_display_get_linenumber_fgcolor);
+
+ procedure fl_text_display_set_linenumber_fgcolor
+ (TD : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_text_display_set_linenumber_fgcolor,
+ "fl_text_display_set_linenumber_fgcolor");
+ pragma Inline (fl_text_display_set_linenumber_fgcolor);
+
+ function fl_text_display_get_linenumber_font
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_get_linenumber_font,
+ "fl_text_display_get_linenumber_font");
+ pragma Inline (fl_text_display_get_linenumber_font);
+
+ procedure fl_text_display_set_linenumber_font
+ (TD : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_set_linenumber_font,
+ "fl_text_display_set_linenumber_font");
+ pragma Inline (fl_text_display_set_linenumber_font);
+
+ function fl_text_display_get_linenumber_size
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_get_linenumber_size,
+ "fl_text_display_get_linenumber_size");
+ pragma Inline (fl_text_display_get_linenumber_size);
+
+ procedure fl_text_display_set_linenumber_size
+ (TD : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_set_linenumber_size,
+ "fl_text_display_set_linenumber_size");
+ pragma Inline (fl_text_display_set_linenumber_size);
+
+ function fl_text_display_get_linenumber_width
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_get_linenumber_width,
+ "fl_text_display_get_linenumber_width");
+ pragma Inline (fl_text_display_get_linenumber_width);
+
+ procedure fl_text_display_set_linenumber_width
+ (TD : in Storage.Integer_Address;
+ W : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_set_linenumber_width,
+ "fl_text_display_set_linenumber_width");
+ pragma Inline (fl_text_display_set_linenumber_width);
+
+
+
+
+ function fl_text_display_move_down
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_move_down, "fl_text_display_move_down");
+ pragma Inline (fl_text_display_move_down);
+
+ function fl_text_display_move_left
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_move_left, "fl_text_display_move_left");
+ pragma Inline (fl_text_display_move_left);
+
+ function fl_text_display_move_right
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_move_right, "fl_text_display_move_right");
+ pragma Inline (fl_text_display_move_right);
+
+ function fl_text_display_move_up
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_move_up, "fl_text_display_move_up");
+ pragma Inline (fl_text_display_move_up);
+
+
+
+
+ procedure fl_text_display_scroll
+ (TD : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_scroll, "fl_text_display_scroll");
+ pragma Inline (fl_text_display_scroll);
+
+ function fl_text_display_get_scrollbar_align
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_text_display_get_scrollbar_align, "fl_text_display_get_scrollbar_align");
+ pragma Inline (fl_text_display_get_scrollbar_align);
+
+ procedure fl_text_display_set_scrollbar_align
+ (TD : in Storage.Integer_Address;
+ A : in Interfaces.C.unsigned);
+ pragma Import (C, fl_text_display_set_scrollbar_align, "fl_text_display_set_scrollbar_align");
+ pragma Inline (fl_text_display_set_scrollbar_align);
+
+ function fl_text_display_get_scrollbar_width
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_get_scrollbar_width, "fl_text_display_get_scrollbar_width");
+ pragma Inline (fl_text_display_get_scrollbar_width);
+
+ procedure fl_text_display_set_scrollbar_width
+ (TD : in Storage.Integer_Address;
+ W : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_set_scrollbar_width, "fl_text_display_set_scrollbar_width");
+ pragma Inline (fl_text_display_set_scrollbar_width);
+
+
+
+
+ procedure fl_text_display_redisplay_range
+ (TD : in Storage.Integer_Address;
+ S, F : in Interfaces.C.int);
+ pragma Import (C, fl_text_display_redisplay_range, "fl_text_display_redisplay_range");
+ pragma Inline (fl_text_display_redisplay_range);
+
+ procedure fl_text_display_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_text_display_draw, "fl_text_display_draw");
+ pragma Inline (fl_text_display_draw);
+
+ function fl_text_display_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_display_handle, "fl_text_display_handle");
+ pragma Inline (fl_text_display_handle);
+
+
+
+
+ ----------------------
+ -- Callback Hooks --
+ ----------------------
+
+ procedure Style_Hook
+ (C : in Interfaces.C.int;
+ D : in Storage.Integer_Address)
+ is
+ use Styles; -- for maximum stylin'
+
+ Ada_Widget : access Text_Display'Class :=
+ Text_Display_Convert.To_Pointer (Storage.To_Address (D));
+ begin
+ if Ada_Widget.Style_Callback /= null then
+ Ada_Widget.Style_Callback (Character'Val (C), Text_Display (Ada_Widget.all));
+ end if;
+ end Style_Hook;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Text_Display) is
+ begin
+ Extra_Final (Group (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Text_Display) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_text_display (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ if This.Raw_Buffer /= Null_Pointer then
+ free_fl_text_buffer (This.Raw_Buffer); -- buffer is reference counted
+ This.Raw_Buffer := Null_Pointer;
+ end if;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Text_Display;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Text_Display) is
+ begin
+ This.Draw_Ptr := fl_text_display_draw'Address;
+ This.Handle_Ptr := fl_text_display_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Text_Display is
+ begin
+ return This : Text_Display do
+ This.Void_Ptr := new_fl_text_display
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Text_Display is
+ begin
+ return This : Text_Display := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ ----------------------
+ -- Child Packages --
+ ----------------------
+
+ package body Styles is
+
+ function Item
+ (Tint : in Color;
+ Font : in Font_Kind;
+ Size : in Font_Size)
+ return Style_Entry is
+ begin
+ return This : Style_Entry do
+ This.Attr := 0;
+ This.Col := Interfaces.C.unsigned (Tint);
+ This.Font := Font_Kind'Pos (Font);
+ This.Size := Interfaces.C.int (Size);
+ end return;
+ end Item;
+
+ pragma Inline (Item);
+
+ end Styles;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Buffer
+ (This : in Text_Display)
+ return FLTK.Text_Buffers.Text_Buffer_Reference is
+ begin
+ return Ref : FLTK.Text_Buffers.Text_Buffer_Reference (This.Buffer);
+ end Get_Buffer;
+
+
+ procedure Set_Buffer
+ (This : in out Text_Display;
+ Buff : in out FLTK.Text_Buffers.Text_Buffer) is
+ begin
+ This.Buffer := Buff'Unchecked_Access;
+ fl_text_display_set_buffer (This.Void_Ptr, Wrapper (Buff).Void_Ptr);
+ if This.Raw_Buffer /= Null_Pointer then
+ free_fl_text_buffer (This.Raw_Buffer);
+ end if;
+ This.Raw_Buffer := Wrapper (Buff).Void_Ptr;
+ upref_fl_text_buffer (This.Raw_Buffer);
+ end Set_Buffer;
+
+
+
+
+ procedure Highlight_Data
+ (This : in out Text_Display;
+ Buff : in out FLTK.Text_Buffers.Text_Buffer;
+ Table : in Styles.Style_Array) is
+ begin
+ fl_text_display_highlight_data
+ (This.Void_Ptr,
+ Wrapper (Buff).Void_Ptr,
+ Storage.To_Integer (Table'Address),
+ Table'Length);
+ end Highlight_Data;
+
+
+ procedure Highlight_Data
+ (This : in out Text_Display;
+ Buff : in out FLTK.Text_Buffers.Text_Buffer;
+ Table : in Styles.Style_Array;
+ Unfinished : in Styles.Style_Index;
+ Callback : in Styles.Unfinished_Style_Callback) is
+ begin
+ This.Style_Callback := Callback;
+ fl_text_display_highlight_data2
+ (This.Void_Ptr,
+ Wrapper (Buff).Void_Ptr,
+ Storage.To_Integer (Table'Address),
+ Table'Length,
+ Character'Pos (Character (Unfinished)),
+ Storage.To_Integer (Style_Hook'Address),
+ Storage.To_Integer (This'Address));
+ end Highlight_Data;
+
+
+
+
+ function Col_To_X
+ (This : in Text_Display;
+ Col_Num : in Integer)
+ return Integer is
+ begin
+ return Integer (Interfaces.C.double'Rounding
+ (fl_text_display_col_to_x (This.Void_Ptr, Interfaces.C.double (Col_Num))));
+ end Col_To_X;
+
+
+ function X_To_Col
+ (This : in Text_Display;
+ X_Pos : in Integer)
+ return Integer is
+ begin
+ return Integer (Interfaces.C.double'Rounding
+ (fl_text_display_x_to_col (This.Void_Ptr, Interfaces.C.double (X_Pos))));
+ end X_To_Col;
+
+
+ function In_Selection
+ (This : in Text_Display;
+ X, Y : in Integer)
+ return Boolean is
+ begin
+ return fl_text_display_in_selection
+ (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y)) /= 0;
+ end In_Selection;
+
+
+ procedure Position_To_XY
+ (This : in Text_Display;
+ Pos : in Integer;
+ X, Y : out Integer;
+ Vert_Out : out Boolean) is
+ begin
+ Vert_Out := fl_text_display_position_to_xy
+ (This.Void_Ptr,
+ Interfaces.C.int (Pos),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y)) /= 0;
+ end Position_To_XY;
+
+
+
+
+ function Get_Cursor_Color
+ (This : in Text_Display)
+ return Color is
+ begin
+ return Color (fl_text_display_get_cursor_color (This.Void_Ptr));
+ end Get_Cursor_Color;
+
+
+ procedure Set_Cursor_Color
+ (This : in out Text_Display;
+ Col : in Color) is
+ begin
+ fl_text_display_set_cursor_color (This.Void_Ptr, Interfaces.C.unsigned (Col));
+ end Set_Cursor_Color;
+
+
+ procedure Set_Cursor_Style
+ (This : in out Text_Display;
+ Style : in Cursor_Style) is
+ begin
+ fl_text_display_set_cursor_style (This.Void_Ptr, Cursor_Style'Pos (Style));
+ end Set_Cursor_Style;
+
+
+ procedure Hide_Cursor
+ (This : in out Text_Display) is
+ begin
+ fl_text_display_hide_cursor (This.Void_Ptr);
+ end Hide_Cursor;
+
+
+ procedure Show_Cursor
+ (This : in out Text_Display) is
+ begin
+ fl_text_display_show_cursor (This.Void_Ptr);
+ end Show_Cursor;
+
+
+
+
+ function Get_Text_Color
+ (This : in Text_Display)
+ return Color is
+ begin
+ return Color (fl_text_display_get_text_color (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Text_Display;
+ Col : in Color) is
+ begin
+ fl_text_display_set_text_color (This.Void_Ptr, Interfaces.C.unsigned (Col));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Text_Display)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_text_display_get_text_font (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Text_Display;
+ Font : in Font_Kind) is
+ begin
+ fl_text_display_set_text_font (This.Void_Ptr, Font_Kind'Pos (Font));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Text_Display)
+ return Font_Size is
+ begin
+ return Font_Size (fl_text_display_get_text_size (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Text_Display;
+ Size : in Font_Size) is
+ begin
+ fl_text_display_set_text_size (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Text_Size;
+
+
+
+
+ procedure Insert_Text
+ (This : in out Text_Display;
+ Item : in String) is
+ begin
+ fl_text_display_insert (This.Void_Ptr, Interfaces.C.To_C (Item));
+ end Insert_Text;
+
+
+ procedure Overstrike
+ (This : in out Text_Display;
+ Text : in String) is
+ begin
+ fl_text_display_overstrike (This.Void_Ptr, Interfaces.C.To_C (Text));
+ end Overstrike;
+
+
+ function Get_Insert_Position
+ (This : in Text_Display)
+ return Natural is
+ begin
+ return Natural (fl_text_display_get_insert_pos (This.Void_Ptr));
+ end Get_Insert_Position;
+
+
+ procedure Set_Insert_Position
+ (This : in out Text_Display;
+ Pos : in Natural) is
+ begin
+ fl_text_display_set_insert_pos (This.Void_Ptr, Interfaces.C.int (Pos));
+ end Set_Insert_Position;
+
+
+ procedure Show_Insert_Position
+ (This : in out Text_Display) is
+ begin
+ fl_text_display_show_insert_pos (This.Void_Ptr);
+ end Show_Insert_Position;
+
+
+
+
+ function Word_Start
+ (This : in out Text_Display;
+ Pos : in Natural)
+ return Natural is
+ begin
+ return Natural (fl_text_display_word_start
+ (This.Void_Ptr,
+ Interfaces.C.int (Pos)));
+ end Word_Start;
+
+
+ function Word_End
+ (This : in out Text_Display;
+ Pos : in Natural)
+ return Natural is
+ begin
+ return Natural (fl_text_display_word_end
+ (This.Void_Ptr,
+ Interfaces.C.int (Pos)));
+ end Word_End;
+
+
+ procedure Next_Word
+ (This : in out Text_Display) is
+ begin
+ fl_text_display_next_word (This.Void_Ptr);
+ end Next_Word;
+
+
+ procedure Previous_Word
+ (This : in out Text_Display) is
+ begin
+ fl_text_display_previous_word (This.Void_Ptr);
+ end Previous_Word;
+
+
+ procedure Set_Wrap_Mode
+ (This : in out Text_Display;
+ Mode : in Wrap_Mode;
+ Margin : in Natural := 0) is
+ begin
+ fl_text_display_wrap_mode
+ (This.Void_Ptr,
+ Wrap_Mode'Pos (Mode),
+ Interfaces.C.int (Margin));
+ end Set_Wrap_Mode;
+
+
+
+
+ function Line_Start
+ (This : in Text_Display;
+ Pos : in Natural)
+ return Natural is
+ begin
+ return Natural (fl_text_display_line_start
+ (This.Void_Ptr,
+ Interfaces.C.int (Pos)));
+ end Line_Start;
+
+
+ function Line_End
+ (This : in Text_Display;
+ Pos : in Natural;
+ Start_Pos_Is_Line_Start : in Boolean := False)
+ return Natural is
+ begin
+ return Natural (fl_text_display_line_end
+ (This.Void_Ptr,
+ Interfaces.C.int (Pos),
+ Boolean'Pos (Start_Pos_Is_Line_Start)));
+ end Line_End;
+
+
+ function Count_Lines
+ (This : in Text_Display;
+ Start, Finish : in Natural;
+ Start_Pos_Is_Line_Start : in Boolean := False)
+ return Natural is
+ begin
+ return Natural (fl_text_display_count_lines
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish),
+ Boolean'Pos (Start_Pos_Is_Line_Start)));
+ end Count_Lines;
+
+
+ function Skip_Lines
+ (This : in Text_Display;
+ Start, Lines : in Natural;
+ Start_Pos_Is_Line_Start : in Boolean := False)
+ return Natural is
+ begin
+ return Natural (fl_text_display_skip_lines
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Lines),
+ Boolean'Pos (Start_Pos_Is_Line_Start)));
+ end Skip_Lines;
+
+
+ function Rewind_Lines
+ (This : in Text_Display;
+ Start, Lines : in Natural)
+ return Natural is
+ begin
+ return Natural (fl_text_display_rewind_lines
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Lines)));
+ end Rewind_Lines;
+
+
+
+
+ function Get_Linenumber_Alignment
+ (This : in Text_Display)
+ return Alignment is
+ begin
+ return Alignment (fl_text_display_get_linenumber_align (This.Void_Ptr));
+ end Get_Linenumber_Alignment;
+
+
+ procedure Set_Linenumber_Alignment
+ (This : in out Text_Display;
+ To : in Alignment) is
+ begin
+ fl_text_display_set_linenumber_align
+ (This.Void_Ptr,
+ Interfaces.C.unsigned (To));
+ end Set_Linenumber_Alignment;
+
+
+ function Get_Linenumber_Back_Color
+ (This : in Text_Display)
+ return Color is
+ begin
+ return Color (fl_text_display_get_linenumber_bgcolor (This.Void_Ptr));
+ end Get_Linenumber_Back_Color;
+
+
+ procedure Set_Linenumber_Back_Color
+ (This : in out Text_Display;
+ To : in Color) is
+ begin
+ fl_text_display_set_linenumber_bgcolor
+ (This.Void_Ptr,
+ Interfaces.C.unsigned (To));
+ end Set_Linenumber_Back_Color;
+
+
+ function Get_Linenumber_Fore_Color
+ (This : in Text_Display)
+ return Color is
+ begin
+ return Color (fl_text_display_get_linenumber_fgcolor (This.Void_Ptr));
+ end Get_Linenumber_Fore_Color;
+
+
+ procedure Set_Linenumber_Fore_Color
+ (This : in out Text_Display;
+ To : in Color) is
+ begin
+ fl_text_display_set_linenumber_fgcolor
+ (This.Void_Ptr,
+ Interfaces.C.unsigned (To));
+ end Set_Linenumber_Fore_Color;
+
+
+ function Get_Linenumber_Font
+ (This : in Text_Display)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_text_display_get_linenumber_font (This.Void_Ptr));
+ end Get_Linenumber_Font;
+
+
+ procedure Set_Linenumber_Font
+ (This : in out Text_Display;
+ To : in Font_Kind) is
+ begin
+ fl_text_display_set_linenumber_font
+ (This.Void_Ptr,
+ Font_Kind'Pos (To));
+ end Set_Linenumber_Font;
+
+
+ function Get_Linenumber_Size
+ (This : in Text_Display)
+ return Font_Size is
+ begin
+ return Font_Size (fl_text_display_get_linenumber_size (This.Void_Ptr));
+ end Get_Linenumber_Size;
+
+
+ procedure Set_Linenumber_Size
+ (This : in out Text_Display;
+ To : in Font_Size) is
+ begin
+ fl_text_display_set_linenumber_size
+ (This.Void_Ptr,
+ Interfaces.C.int (To));
+ end Set_Linenumber_Size;
+
+
+ function Get_Linenumber_Width
+ (This : in Text_Display)
+ return Natural is
+ begin
+ return Natural (fl_text_display_get_linenumber_width (This.Void_Ptr));
+ end Get_Linenumber_Width;
+
+
+ procedure Set_Linenumber_Width
+ (This : in out Text_Display;
+ Width : in Natural) is
+ begin
+ fl_text_display_set_linenumber_width
+ (This.Void_Ptr,
+ Interfaces.C.int (Width));
+ end Set_Linenumber_Width;
+
+
+
+
+ procedure Move_Down
+ (This : in out Text_Display) is
+ begin
+ if fl_text_display_move_down (This.Void_Ptr) = 0 then
+ raise Bounds_Error;
+ end if;
+ end Move_Down;
+
+
+ procedure Move_Left
+ (This : in out Text_Display) is
+ begin
+ if fl_text_display_move_left (This.Void_Ptr) = 0 then
+ raise Bounds_Error;
+ end if;
+ end Move_Left;
+
+
+ procedure Move_Right
+ (This : in out Text_Display) is
+ begin
+ if fl_text_display_move_right (This.Void_Ptr) = 0 then
+ raise Bounds_Error;
+ end if;
+ end Move_Right;
+
+
+ procedure Move_Up
+ (This : in out Text_Display) is
+ begin
+ if fl_text_display_move_up (This.Void_Ptr) = 0 then
+ raise Bounds_Error;
+ end if;
+ end Move_Up;
+
+
+
+
+ procedure Scroll_To
+ (This : in out Text_Display;
+ Line : in Natural) is
+ begin
+ fl_text_display_scroll (This.Void_Ptr, Interfaces.C.int (Line));
+ end Scroll_To;
+
+
+ function Get_Scrollbar_Alignment
+ (This : in Text_Display)
+ return Alignment is
+ begin
+ return Alignment (fl_text_display_get_scrollbar_align (This.Void_Ptr));
+ end Get_Scrollbar_Alignment;
+
+
+ procedure Set_Scrollbar_Alignment
+ (This : in out Text_Display;
+ Align : in Alignment) is
+ begin
+ fl_text_display_set_scrollbar_align
+ (This.Void_Ptr,
+ Interfaces.C.unsigned (Align));
+ end Set_Scrollbar_Alignment;
+
+
+ function Get_Scrollbar_Width
+ (This : in Text_Display)
+ return Natural is
+ begin
+ return Natural (fl_text_display_get_scrollbar_width (This.Void_Ptr));
+ end Get_Scrollbar_Width;
+
+
+ procedure Set_Scrollbar_Width
+ (This : in out Text_Display;
+ Width : in Natural) is
+ begin
+ fl_text_display_set_scrollbar_width
+ (This.Void_Ptr,
+ Interfaces.C.int (Width));
+ end Set_Scrollbar_Width;
+
+
+
+
+ procedure Redisplay_Range
+ (This : in out Text_Display;
+ Start, Finish : in Natural) is
+ begin
+ fl_text_display_redisplay_range
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish));
+ end Redisplay_Range;
+
+
+ procedure Draw
+ (This : in out Text_Display) is
+ begin
+ Group (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Text_Display;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Group (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Groups.Text_Displays;
+
+
diff --git a/body/fltk-widgets-groups-tiled.adb b/body/fltk-widgets-groups-tiled.adb
new file mode 100644
index 0000000..9bbf394
--- /dev/null
+++ b/body/fltk-widgets-groups-tiled.adb
@@ -0,0 +1,186 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Groups.Tiled is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_tile
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_tile, "new_fl_tile");
+ pragma Inline (new_fl_tile);
+
+ procedure free_fl_tile
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_tile, "free_fl_tile");
+ pragma Inline (free_fl_tile);
+
+
+
+
+ procedure fl_tile_position
+ (T : in Storage.Integer_Address;
+ OX, OY, NX, NY : in Interfaces.C.int);
+ pragma Import (C, fl_tile_position, "fl_tile_position");
+ pragma Inline (fl_tile_position);
+
+ procedure fl_tile_resize
+ (T : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_tile_resize, "fl_tile_resize");
+ pragma Inline (fl_tile_resize);
+
+
+
+
+ procedure fl_tile_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_tile_draw, "fl_tile_draw");
+ pragma Inline (fl_tile_draw);
+
+ function fl_tile_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_tile_handle, "fl_tile_handle");
+ pragma Inline (fl_tile_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Tiled_Group) is
+ begin
+ Extra_Final (Group (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Tiled_Group) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_tile (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Tiled_Group;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Tiled_Group) is
+ begin
+ This.Draw_Ptr := fl_tile_draw'Address;
+ This.Handle_Ptr := fl_tile_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Tiled_Group is
+ begin
+ return This : Tiled_Group do
+ This.Void_Ptr := new_fl_tile
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Tiled_Group is
+ begin
+ return This : Tiled_Group := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Position
+ (This : in out Tiled_Group;
+ Old_X, Old_Y : in Integer;
+ New_X, New_Y : in Integer) is
+ begin
+ fl_tile_position
+ (This.Void_Ptr,
+ Interfaces.C.int (Old_X), Interfaces.C.int (Old_Y),
+ Interfaces.C.int (New_X), Interfaces.C.int (New_Y));
+ end Position;
+
+
+ procedure Resize
+ (This : in out Tiled_Group;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_tile_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+
+
+ function Handle
+ (This : in out Tiled_Group;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Group (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Groups.Tiled;
+
+
diff --git a/body/fltk-widgets-groups-windows-double-cairo.adb b/body/fltk-widgets-groups-windows-double-cairo.adb
new file mode 100644
index 0000000..897c206
--- /dev/null
+++ b/body/fltk-widgets-groups-windows-double-cairo.adb
@@ -0,0 +1,248 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C,
+ System.Address_To_Access_Conversions;
+
+
+package body FLTK.Widgets.Groups.Windows.Double.Cairo is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_cairo_window
+ (W, H : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_cairo_window, "new_fl_cairo_window");
+ pragma Inline (new_fl_cairo_window);
+
+ procedure free_fl_cairo_window
+ (W : in Storage.Integer_Address);
+ pragma Import (C, free_fl_cairo_window, "free_fl_cairo_window");
+ pragma Inline (free_fl_cairo_window);
+
+
+
+
+ procedure fl_cairo_window_set_draw_cb
+ (W, F : in Storage.Integer_Address);
+ pragma Import (C, fl_cairo_window_set_draw_cb, "fl_cairo_window_set_draw_cb");
+ pragma Inline (fl_cairo_window_set_draw_cb);
+
+
+
+
+ procedure fl_cairo_window_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_cairo_window_draw, "fl_cairo_window_draw");
+ pragma Inline (fl_cairo_window_draw);
+
+ function fl_cairo_window_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_cairo_window_handle, "fl_cairo_window_handle");
+ pragma Inline (fl_cairo_window_handle);
+
+
+
+
+ ----------------------
+ -- Callback Hooks --
+ ----------------------
+
+ package Cairo_Convert is new System.Address_To_Access_Conversions (Cairo_Window'Class);
+
+
+ procedure Cairo_Draw_Hook
+ (C_Addr, Cairo_Addr : in Storage.Integer_Address);
+
+ pragma Convention (C, Cairo_Draw_Hook);
+
+ procedure Cairo_Draw_Hook
+ (C_Addr, Cairo_Addr : in Storage.Integer_Address)
+ is
+ Ada_Addr : System.Address :=
+ Storage.To_Address (fl_widget_get_user_data (C_Addr));
+ Ada_Object : access Cairo_Window'Class :=
+ Cairo_Convert.To_Pointer (Ada_Addr);
+ begin
+ pragma Assert (Ada_Object /= null);
+ if Ada_Object.My_Func /= null then
+ Ada_Object.My_Func (Cairo_Window (Ada_Object.all), Storage.To_Address (Cairo_Addr));
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Cairo_Draw_Hook;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Cairo_Window) is
+ begin
+ Extra_Final (Double_Window (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Cairo_Window) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_cairo_window (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Cairo_Window;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ fl_cairo_window_set_draw_cb (This.Void_Ptr, Storage.To_Integer (Cairo_Draw_Hook'Address));
+ Extra_Init (Double_Window (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Cairo_Window) is
+ begin
+ This.Draw_Ptr := fl_cairo_window_draw'Address;
+ This.Handle_Ptr := fl_cairo_window_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Cairo_Window is
+ begin
+ return This : Cairo_Window do
+ This.Void_Ptr := new_fl_cairo_window
+ (Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ This.Reposition (X, Y);
+ This.Set_Label (Text);
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Cairo_Window is
+ begin
+ return This : Cairo_Window := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+
+ function Create
+ (W, H : in Integer;
+ Text : in String)
+ return Cairo_Window is
+ begin
+ return This : Cairo_Window do
+ This.Void_Ptr := new_fl_cairo_window
+ (Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ This.Set_Label (Text);
+ Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ W, H : in Integer;
+ Text : in String)
+ return Cairo_Window is
+ begin
+ return This : Cairo_Window := Create (W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+
+ function Create
+ (W, H : in Integer)
+ return Cairo_Window is
+ begin
+ return This : Cairo_Window do
+ This.Void_Ptr := new_fl_cairo_window
+ (Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ Extra_Init (This, This.Get_X, This.Get_Y, W, H, This.Get_Label);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ W, H : in Integer)
+ return Cairo_Window is
+ begin
+ return This : Cairo_Window := Create (W, H) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ ------------------------
+ -- Cairo Window API --
+ ------------------------
+
+ procedure Set_Cairo_Draw
+ (This : in out Cairo_Window;
+ Func : in Cairo_Callback) is
+ begin
+ This.My_Func := Func;
+ end Set_Cairo_Draw;
+
+
+
+
+ procedure Draw
+ (This : in out Cairo_Window) is
+ begin
+ Double_Window (This).Draw;
+ end Draw;
+
+
+end FLTK.Widgets.Groups.Windows.Double.Cairo;
+
+
diff --git a/body/fltk-widgets-groups-windows-double-overlay.adb b/body/fltk-widgets-groups-windows-double-overlay.adb
new file mode 100644
index 0000000..c4460f1
--- /dev/null
+++ b/body/fltk-widgets-groups-windows-double-overlay.adb
@@ -0,0 +1,317 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Show_Argv,
+ Interfaces.C,
+ System.Address_To_Access_Conversions;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Groups.Windows.Double.Overlay is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_overlay_window
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_overlay_window, "new_fl_overlay_window");
+ pragma Inline (new_fl_overlay_window);
+
+ function new_fl_overlay_window2
+ (W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_overlay_window2, "new_fl_overlay_window2");
+ pragma Inline (new_fl_overlay_window2);
+
+ procedure free_fl_overlay_window
+ (S : in Storage.Integer_Address);
+ pragma Import (C, free_fl_overlay_window, "free_fl_overlay_window");
+ pragma Inline (free_fl_overlay_window);
+
+
+
+
+ procedure fl_overlay_window_show
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_overlay_window_show, "fl_overlay_window_show");
+ pragma Inline (fl_overlay_window_show);
+
+ procedure fl_overlay_window_show2
+ (W : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ V : in Storage.Integer_Address);
+ pragma Import (C, fl_overlay_window_show2, "fl_overlay_window_show2");
+ pragma Inline (fl_overlay_window_show2);
+
+ procedure fl_overlay_window_hide
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_overlay_window_hide, "fl_overlay_window_hide");
+ pragma Inline (fl_overlay_window_hide);
+
+ procedure fl_overlay_window_flush
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_overlay_window_flush, "fl_overlay_window_flush");
+ pragma Inline (fl_overlay_window_flush);
+
+
+
+
+ function fl_overlay_window_can_do_overlay
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_overlay_window_can_do_overlay, "fl_overlay_window_can_do_overlay");
+ pragma Inline (fl_overlay_window_can_do_overlay);
+
+ procedure fl_overlay_window_resize
+ (OW : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_overlay_window_resize, "fl_overlay_window_resize");
+ pragma Inline (fl_overlay_window_resize);
+
+
+
+
+ procedure fl_overlay_window_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_overlay_window_draw, "fl_overlay_window_draw");
+ pragma Inline (fl_overlay_window_draw);
+
+ procedure fl_overlay_window_redraw_overlay
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_overlay_window_redraw_overlay, "fl_overlay_window_redraw_overlay");
+ pragma Inline (fl_overlay_window_redraw_overlay);
+
+ function fl_overlay_window_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_overlay_window_handle, "fl_overlay_window_handle");
+ pragma Inline (fl_overlay_window_handle);
+
+
+
+
+ ----------------------
+ -- Exported Hooks --
+ ----------------------
+
+ package Over_Convert is new System.Address_To_Access_Conversions (Overlay_Window'Class);
+
+ procedure Overlay_Window_Draw_Overlay_Hook
+ (U : in Storage.Integer_Address);
+ pragma Export (C, Overlay_Window_Draw_Overlay_Hook, "overlay_window_draw_overlay_hook");
+
+ procedure Overlay_Window_Draw_Overlay_Hook
+ (U : in Storage.Integer_Address)
+ is
+ Overlay_Widget : access Overlay_Window'Class :=
+ Over_Convert.To_Pointer (Storage.To_Address (U));
+ begin
+ Overlay_Widget.Draw_Overlay;
+ end Overlay_Window_Draw_Overlay_Hook;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Overlay_Window) is
+ begin
+ Extra_Final (Double_Window (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Overlay_Window) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_overlay_window (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Overlay_Window;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Double_Window (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Overlay_Window) is
+ begin
+ This.Draw_Ptr := fl_overlay_window_draw'Address;
+ This.Handle_Ptr := fl_overlay_window_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Overlay_Window is
+ begin
+ return This : Overlay_Window do
+ This.Void_Ptr := new_fl_overlay_window
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Overlay_Window is
+ begin
+ return This : Overlay_Window := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+
+ function Create
+ (W, H : in Integer;
+ Text : in String := "")
+ return Overlay_Window is
+ begin
+ return This : Overlay_Window do
+ This.Void_Ptr := new_fl_overlay_window2
+ (Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ W, H : in Integer;
+ Text : in String := "")
+ return Overlay_Window is
+ begin
+ return This : Overlay_Window := Create (W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ ---------------
+ -- Display --
+ ---------------
+
+ procedure Show
+ (This : in out Overlay_Window) is
+ begin
+ fl_overlay_window_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Show_With_Args
+ (This : in out Overlay_Window) is
+ begin
+ FLTK.Show_Argv.Dispatch (fl_overlay_window_show2'Access, This.Void_Ptr);
+ end Show_With_Args;
+
+
+ procedure Hide
+ (This : in out Overlay_Window) is
+ begin
+ fl_overlay_window_hide (This.Void_Ptr);
+ end Hide;
+
+
+ procedure Flush
+ (This : in out Overlay_Window) is
+ begin
+ fl_overlay_window_flush (This.Void_Ptr);
+ end Flush;
+
+
+
+
+ -------------
+ -- Other --
+ -------------
+
+ function Can_Do_Overlay
+ (This : in Overlay_Window)
+ return Boolean is
+ begin
+ return fl_overlay_window_can_do_overlay (This.Void_Ptr) /= 0;
+ end Can_Do_Overlay;
+
+
+ procedure Resize
+ (This : in out Overlay_Window;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_overlay_window_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+
+
+ ----------------------------------
+ -- Drawing and Event Handling --
+ ----------------------------------
+
+ procedure Draw_Overlay
+ (This : in out Overlay_Window) is
+ begin
+ raise Program_Error with "You must override Draw_Overlay";
+ end Draw_Overlay;
+
+
+ procedure Redraw_Overlay
+ (This : in out Overlay_Window) is
+ begin
+ fl_overlay_window_redraw_overlay (This.Void_Ptr);
+ end Redraw_Overlay;
+
+
+end FLTK.Widgets.Groups.Windows.Double.Overlay;
+
+
diff --git a/body/fltk-widgets-groups-windows-double.adb b/body/fltk-widgets-groups-windows-double.adb
new file mode 100644
index 0000000..90a17f3
--- /dev/null
+++ b/body/fltk-widgets-groups-windows-double.adb
@@ -0,0 +1,260 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Show_Argv,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Groups.Windows.Double is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_double_window
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_double_window, "new_fl_double_window");
+ pragma Inline (new_fl_double_window);
+
+ function new_fl_double_window2
+ (X, Y : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_double_window2, "new_fl_double_window2");
+ pragma Inline (new_fl_double_window2);
+
+ procedure free_fl_double_window
+ (W : in Storage.Integer_Address);
+ pragma Import (C, free_fl_double_window, "free_fl_double_window");
+ pragma Inline (free_fl_double_window);
+
+
+
+
+ procedure fl_double_window_show
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_double_window_show, "fl_double_window_show");
+ pragma Inline (fl_double_window_show);
+
+ procedure fl_double_window_show2
+ (W : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ V : in Storage.Integer_Address);
+ pragma Import (C, fl_double_window_show2, "fl_double_window_show2");
+ pragma Inline (fl_double_window_show2);
+
+ procedure fl_double_window_hide
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_double_window_hide, "fl_double_window_hide");
+ pragma Inline (fl_double_window_hide);
+
+ procedure fl_double_window_flush
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_double_window_flush, "fl_double_window_flush");
+ pragma Inline (fl_double_window_flush);
+
+ procedure fl_double_window_flush2
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int);
+ pragma Import (C, fl_double_window_flush2, "fl_double_window_flush2");
+ pragma Inline (fl_double_window_flush2);
+
+
+
+
+ procedure fl_double_window_resize
+ (DW : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_double_window_resize, "fl_double_window_resize");
+ pragma Inline (fl_double_window_resize);
+
+
+
+
+ procedure fl_double_window_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_double_window_draw, "fl_double_window_draw");
+ pragma Inline (fl_double_window_draw);
+
+ function fl_double_window_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_double_window_handle, "fl_double_window_handle");
+ pragma Inline (fl_double_window_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Double_Window) is
+ begin
+ Extra_Final (Window (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Double_Window) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_double_window (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Double_Window;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Window (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Double_Window) is
+ begin
+ This.Draw_Ptr := fl_double_window_draw'Address;
+ This.Handle_Ptr := fl_double_window_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Double_Window is
+ begin
+ return This : Double_Window := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+
+ function Create
+ (W, H : in Integer;
+ Text : in String := "")
+ 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),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ W, H : in Integer;
+ Text : in String := "")
+ return Double_Window is
+ begin
+ return This : Double_Window := Create (W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Show
+ (This : in out Double_Window) is
+ begin
+ fl_double_window_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Show_With_Args
+ (This : in out Double_Window) is
+ begin
+ FLTK.Show_Argv.Dispatch (fl_double_window_show2'Access, This.Void_Ptr);
+ end Show_With_Args;
+
+
+ procedure Hide
+ (This : in out Double_Window) is
+ begin
+ fl_double_window_hide (This.Void_Ptr);
+ end Hide;
+
+
+ procedure Flush
+ (This : in out Double_Window) is
+ begin
+ fl_double_window_flush (This.Void_Ptr);
+ end Flush;
+
+
+ procedure Flush_All
+ (This : in out Double_Window) is
+ begin
+ fl_double_window_flush2 (This.Void_Ptr, 1);
+ end Flush_All;
+
+
+
+
+ procedure Resize
+ (This : in out Double_Window;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_double_window_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+end FLTK.Widgets.Groups.Windows.Double;
+
+
diff --git a/body/fltk-widgets-groups-windows-opengl.adb b/body/fltk-widgets-groups-windows-opengl.adb
new file mode 100644
index 0000000..da2434c
--- /dev/null
+++ b/body/fltk-widgets-groups-windows-opengl.adb
@@ -0,0 +1,580 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Show_Argv,
+ Interfaces.C,
+ System;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.signed_char,
+ Interfaces.C.unsigned;
+
+
+package body FLTK.Widgets.Groups.Windows.OpenGL is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_gl_window
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_gl_window, "new_fl_gl_window");
+ pragma Inline (new_fl_gl_window);
+
+ function new_fl_gl_window2
+ (W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_gl_window2, "new_fl_gl_window2");
+ pragma Inline (new_fl_gl_window2);
+
+ procedure free_fl_gl_window
+ (S : in Storage.Integer_Address);
+ pragma Import (C, free_fl_gl_window, "free_fl_gl_window");
+ pragma Inline (free_fl_gl_window);
+
+
+
+
+ procedure fl_gl_window_show
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_show, "fl_gl_window_show");
+ pragma Inline (fl_gl_window_show);
+
+ procedure fl_gl_window_show2
+ (S : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ V : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_show2, "fl_gl_window_show2");
+ pragma Inline (fl_gl_window_show2);
+
+ procedure fl_gl_window_hide
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_hide, "fl_gl_window_hide");
+ pragma Inline (fl_gl_window_hide);
+
+ procedure fl_gl_window_hide_overlay
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_hide_overlay, "fl_gl_window_hide_overlay");
+ pragma Inline (fl_gl_window_hide_overlay);
+
+ procedure fl_gl_window_flush
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_flush, "fl_gl_window_flush");
+ pragma Inline (fl_gl_window_flush);
+
+
+
+
+ function fl_gl_window_pixel_h
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_gl_window_pixel_h, "fl_gl_window_pixel_h");
+ pragma Inline (fl_gl_window_pixel_h);
+
+ function fl_gl_window_pixel_w
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_gl_window_pixel_w, "fl_gl_window_pixel_w");
+ pragma Inline (fl_gl_window_pixel_w);
+
+ function fl_gl_window_pixels_per_unit
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.C_float;
+ pragma Import (C, fl_gl_window_pixels_per_unit, "fl_gl_window_pixels_per_unit");
+ pragma Inline (fl_gl_window_pixels_per_unit);
+
+ procedure fl_gl_window_resize
+ (G : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_gl_window_resize, "fl_gl_window_resize");
+ pragma Inline (fl_gl_window_resize);
+
+
+
+
+ function fl_gl_window_get_mode
+ (S : in Storage.Integer_Address)
+ return Mode_Mask;
+ pragma Import (C, fl_gl_window_get_mode, "fl_gl_window_get_mode");
+ pragma Inline (fl_gl_window_get_mode);
+
+ procedure fl_gl_window_set_mode
+ (S : in Storage.Integer_Address;
+ M : in Mode_Mask);
+ pragma Import (C, fl_gl_window_set_mode, "fl_gl_window_set_mode");
+ pragma Inline (fl_gl_window_set_mode);
+
+ function fl_gl_window_static_can_do
+ (M : in Mode_Mask)
+ return Interfaces.C.int;
+ pragma Import (C, fl_gl_window_static_can_do, "fl_gl_window_static_can_do");
+ pragma Inline (fl_gl_window_static_can_do);
+
+ function fl_gl_window_can_do
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_gl_window_can_do, "fl_gl_window_can_do");
+ pragma Inline (fl_gl_window_can_do);
+
+ function fl_gl_window_can_do_overlay
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_gl_window_can_do_overlay, "fl_gl_window_can_do_overlay");
+ pragma Inline (fl_gl_window_can_do_overlay);
+
+
+
+
+ function fl_gl_window_get_context
+ (S : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_gl_window_get_context, "fl_gl_window_get_context");
+ pragma Inline (fl_gl_window_get_context);
+
+ procedure fl_gl_window_set_context
+ (S, P : in Storage.Integer_Address;
+ D : in Interfaces.C.int);
+ pragma Import (C, fl_gl_window_set_context, "fl_gl_window_set_context");
+ pragma Inline (fl_gl_window_set_context);
+
+ function fl_gl_window_context_valid
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.signed_char;
+ pragma Import (C, fl_gl_window_context_valid, "fl_gl_window_context_valid");
+ pragma Inline (fl_gl_window_context_valid);
+
+ procedure fl_gl_window_set_context_valid
+ (S : in Storage.Integer_Address;
+ V : in Interfaces.C.signed_char);
+ pragma Import (C, fl_gl_window_set_context_valid, "fl_gl_window_set_context_valid");
+ pragma Inline (fl_gl_window_set_context_valid);
+
+ function fl_gl_window_valid
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.signed_char;
+ pragma Import (C, fl_gl_window_valid, "fl_gl_window_valid");
+ pragma Inline (fl_gl_window_valid);
+
+ procedure fl_gl_window_set_valid
+ (S : in Storage.Integer_Address;
+ V : in Interfaces.C.signed_char);
+ pragma Import (C, fl_gl_window_set_valid, "fl_gl_window_set_valid");
+ pragma Inline (fl_gl_window_set_valid);
+
+ procedure fl_gl_window_invalidate
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_invalidate, "fl_gl_window_invalidate");
+ pragma Inline (fl_gl_window_invalidate);
+
+ procedure fl_gl_window_make_current
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_make_current, "fl_gl_window_make_current");
+ pragma Inline (fl_gl_window_make_current);
+
+ procedure fl_gl_window_make_overlay_current
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_make_overlay_current, "fl_gl_window_make_overlay_current");
+ pragma Inline (fl_gl_window_make_overlay_current);
+
+
+
+
+ procedure fl_gl_window_ortho
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_ortho, "fl_gl_window_ortho");
+ pragma Inline (fl_gl_window_ortho);
+
+ procedure fl_gl_window_redraw_overlay
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_redraw_overlay, "fl_gl_window_redraw_overlay");
+ pragma Inline (fl_gl_window_redraw_overlay);
+
+ procedure fl_gl_window_swap_buffers
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_swap_buffers, "fl_gl_window_swap_buffers");
+ pragma Inline (fl_gl_window_swap_buffers);
+
+ procedure fl_gl_window_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_gl_window_draw, "fl_gl_window_draw");
+ pragma Inline (fl_gl_window_draw);
+
+ function fl_gl_window_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_gl_window_handle, "fl_gl_window_handle");
+ pragma Inline (fl_gl_window_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out GL_Window) is
+ begin
+ Extra_Final (Window (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out GL_Window) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_gl_window (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out GL_Window;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Window (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out GL_Window) is
+ begin
+ This.Draw_Ptr := fl_gl_window_draw'Address;
+ This.Handle_Ptr := fl_gl_window_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return GL_Window is
+ begin
+ return This : GL_Window do
+ This.Void_Ptr := new_fl_gl_window
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return GL_Window is
+ begin
+ return This : GL_Window := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+
+ function Create
+ (W, H : in Integer;
+ Text : in String := "")
+ return GL_Window is
+ begin
+ return This : GL_Window do
+ This.Void_Ptr := new_fl_gl_window2
+ (Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ W, H : in Integer;
+ Text : in String := "")
+ return GL_Window is
+ begin
+ return This : GL_Window := Create (W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ ---------------
+ -- Display --
+ ---------------
+
+ procedure Show
+ (This : in out GL_Window) is
+ begin
+ fl_gl_window_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Show_With_Args
+ (This : in out GL_Window) is
+ begin
+ FLTK.Show_Argv.Dispatch (fl_gl_window_show2'Access, This.Void_Ptr);
+ end Show_With_Args;
+
+
+ procedure Hide
+ (This : in out GL_Window) is
+ begin
+ fl_gl_window_hide (This.Void_Ptr);
+ end Hide;
+
+
+ procedure Hide_Overlay
+ (This : in out GL_Window) is
+ begin
+ fl_gl_window_hide_overlay (This.Void_Ptr);
+ end Hide_Overlay;
+
+
+ procedure Flush
+ (This : in out GL_Window) is
+ begin
+ fl_gl_window_flush (This.Void_Ptr);
+ end Flush;
+
+
+
+
+ ------------------
+ -- Dimensions --
+ ------------------
+
+ function Pixel_H
+ (This : in GL_Window)
+ return Integer is
+ begin
+ return Integer (fl_gl_window_pixel_h (This.Void_Ptr));
+ end Pixel_H;
+
+
+ function Pixel_W
+ (This : in GL_Window)
+ return Integer is
+ begin
+ return Integer (fl_gl_window_pixel_w (This.Void_Ptr));
+ end Pixel_W;
+
+
+ function Pixels_Per_Unit
+ (This : in GL_Window)
+ return Float is
+ begin
+ return Float (fl_gl_window_pixels_per_unit (This.Void_Ptr));
+ end Pixels_Per_Unit;
+
+
+ procedure Resize
+ (This : in out GL_Window;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_gl_window_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+
+
+ --------------------
+ -- OpenGL Modes --
+ --------------------
+
+ function Get_Mode
+ (This : in GL_Window)
+ return Mode_Mask is
+ begin
+ return fl_gl_window_get_mode (This.Void_Ptr);
+ end Get_Mode;
+
+
+ procedure Set_Mode
+ (This : in out GL_Window;
+ Mask : in Mode_Mask) is
+ begin
+ fl_gl_window_set_mode (This.Void_Ptr, Mask);
+ end Set_Mode;
+
+
+ function Can_Do
+ (Mask : in Mode_Mask)
+ return Boolean is
+ begin
+ return fl_gl_window_static_can_do (Mask) /= 0;
+ end Can_Do;
+
+
+ function Can_Do
+ (This : in GL_Window)
+ return Boolean is
+ begin
+ return fl_gl_window_can_do (This.Void_Ptr) /= 0;
+ end Can_Do;
+
+
+ function Can_Do_Overlay
+ (This : in GL_Window)
+ return Boolean is
+ begin
+ return fl_gl_window_can_do_overlay (This.Void_Ptr) /= 0;
+ end Can_Do_Overlay;
+
+
+
+
+ -----------------------
+ -- OpenGL Contexts --
+ -----------------------
+
+ function Get_Context
+ (This : in GL_Window)
+ return System.Address is
+ begin
+ return Storage.To_Address (fl_gl_window_get_context (This.Void_Ptr));
+ end Get_Context;
+
+
+ procedure Set_Context
+ (This : in out GL_Window;
+ Struct : in System.Address;
+ Destroy : in Boolean := False) is
+ begin
+ fl_gl_window_set_context
+ (This.Void_Ptr, Storage.To_Integer (Struct), Boolean'Pos (Destroy));
+ end Set_Context;
+
+
+ function Get_Context_Valid
+ (This : in GL_Window)
+ return Boolean is
+ begin
+ return fl_gl_window_context_valid (This.Void_Ptr) /= 0;
+ end Get_Context_Valid;
+
+
+ procedure Set_Context_Valid
+ (This : in out GL_Window;
+ Value : in Boolean) is
+ begin
+ fl_gl_window_set_context_valid (This.Void_Ptr, Boolean'Pos (Value));
+ end Set_Context_Valid;
+
+
+ function Get_Valid
+ (This : in GL_Window)
+ return Boolean is
+ begin
+ return fl_gl_window_valid (This.Void_Ptr) /= 0;
+ end Get_Valid;
+
+
+ procedure Set_Valid
+ (This : in out GL_Window;
+ Value : in Boolean) is
+ begin
+ fl_gl_window_set_valid (This.Void_Ptr, Boolean'Pos (Value));
+ end Set_Valid;
+
+
+ procedure Invalidate
+ (This : in out GL_Window) is
+ begin
+ fl_gl_window_invalidate (This.Void_Ptr);
+ end Invalidate;
+
+
+ procedure Make_Current
+ (This : in out GL_Window) is
+ begin
+ fl_gl_window_make_current (This.Void_Ptr);
+ end Make_Current;
+
+
+ procedure Make_Overlay_Current
+ (This : in out GL_Window) is
+ begin
+ fl_gl_window_make_overlay_current (This.Void_Ptr);
+ end Make_Overlay_Current;
+
+
+
+
+ ----------------------------------
+ -- Drawing and Event Handling --
+ ----------------------------------
+
+ procedure Ortho
+ (This : in out GL_Window) is
+ begin
+ fl_gl_window_ortho (This.Void_Ptr);
+ end Ortho;
+
+
+ procedure Redraw_Overlay
+ (This : in out GL_Window) is
+ begin
+ fl_gl_window_redraw_overlay (This.Void_Ptr);
+ end Redraw_Overlay;
+
+
+ procedure Swap_Buffers
+ (This : in out GL_Window) is
+ begin
+ fl_gl_window_swap_buffers (This.Void_Ptr);
+ end Swap_Buffers;
+
+
+ procedure Draw
+ (This : in out GL_Window) is
+ begin
+ Window (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out GL_Window;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Window (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Groups.Windows.OpenGL;
+
+
diff --git a/body/fltk-widgets-groups-windows-single-menu.adb b/body/fltk-widgets-groups-windows-single-menu.adb
new file mode 100644
index 0000000..063961e
--- /dev/null
+++ b/body/fltk-widgets-groups-windows-single-menu.adb
@@ -0,0 +1,272 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+use type
+
+ Interfaces.C.unsigned;
+
+
+package body FLTK.Widgets.Groups.Windows.Single.Menu is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_menu_window
+ (X, Y, W, H : in Interfaces.C.int;
+ Label : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_menu_window, "new_fl_menu_window");
+ pragma Inline (new_fl_menu_window);
+
+ function new_fl_menu_window2
+ (W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_menu_window2, "new_fl_menu_window2");
+ pragma Inline (new_fl_menu_window2);
+
+ procedure free_fl_menu_window
+ (M : in Storage.Integer_Address);
+ pragma Import (C, free_fl_menu_window, "free_fl_menu_window");
+ pragma Inline (free_fl_menu_window);
+
+
+
+
+ procedure fl_menu_window_show
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_window_show, "fl_menu_window_show");
+ pragma Inline (fl_menu_window_show);
+
+ procedure fl_menu_window_hide
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_window_hide, "fl_menu_window_hide");
+ pragma Inline (fl_menu_window_hide);
+
+ procedure fl_menu_window_flush
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_window_flush, "fl_menu_window_flush");
+ pragma Inline (fl_menu_window_flush);
+
+ procedure fl_menu_window_erase
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_window_erase, "fl_menu_window_erase");
+ pragma Inline (fl_menu_window_erase);
+
+
+
+
+ procedure fl_menu_window_set_overlay
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_window_set_overlay, "fl_menu_window_set_overlay");
+ pragma Inline (fl_menu_window_set_overlay);
+
+ procedure fl_menu_window_clear_overlay
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_window_clear_overlay, "fl_menu_window_clear_overlay");
+ pragma Inline (fl_menu_window_clear_overlay);
+
+ function fl_menu_window_overlay
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_menu_window_overlay, "fl_menu_window_overlay");
+ pragma Inline (fl_menu_window_overlay);
+
+
+
+
+ procedure fl_menu_window_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_window_draw, "fl_menu_window_draw");
+ pragma Inline (fl_menu_window_draw);
+
+ function fl_menu_window_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_window_handle, "fl_menu_window_handle");
+ pragma Inline (fl_menu_window_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Menu_Window) is
+ begin
+ Extra_Final (Single_Window (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Menu_Window) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_menu_window (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Menu_Window;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Single_Window (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Menu_Window) is
+ begin
+ This.Draw_Ptr := fl_menu_window_draw'Address;
+ This.Handle_Ptr := fl_menu_window_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Menu_Window is
+ begin
+ return This : Menu_Window := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+
+ function Create
+ (W, H : in Integer;
+ Text : in String := "")
+ 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),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ W, H : in Integer;
+ Text : in String := "")
+ return Menu_Window is
+ begin
+ return This : Menu_Window := Create (W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Show
+ (This : in out Menu_Window) is
+ begin
+ fl_menu_window_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Hide
+ (This : in out 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;
+
+
+ procedure Erase
+ (This : in out Menu_Window) is
+ begin
+ fl_menu_window_erase (This.Void_Ptr);
+ end Erase;
+
+
+
+
+ function Is_Overlay
+ (This : in Menu_Window)
+ return Boolean is
+ begin
+ return fl_menu_window_overlay (This.Void_Ptr) /= 0;
+ end Is_Overlay;
+
+
+ procedure Set_Overlay
+ (This : in out Menu_Window;
+ Value : in Boolean := True) 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;
+
+
+ procedure Clear_Overlay
+ (This : in out Menu_Window) is
+ begin
+ fl_menu_window_clear_overlay (This.Void_Ptr);
+ end Clear_Overlay;
+
+
+end FLTK.Widgets.Groups.Windows.Single.Menu;
+
+
diff --git a/body/fltk-widgets-groups-windows-single.adb b/body/fltk-widgets-groups-windows-single.adb
new file mode 100644
index 0000000..109c07e
--- /dev/null
+++ b/body/fltk-widgets-groups-windows-single.adb
@@ -0,0 +1,228 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Show_Argv,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Groups.Windows.Single is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_single_window
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_single_window, "new_fl_single_window");
+ pragma Inline (new_fl_single_window);
+
+ function new_fl_single_window2
+ (W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_single_window2, "new_fl_single_window2");
+ pragma Inline (new_fl_single_window2);
+
+ procedure free_fl_single_window
+ (S : in Storage.Integer_Address);
+ pragma Import (C, free_fl_single_window, "free_fl_single_window");
+ pragma Inline (free_fl_single_window);
+
+
+
+
+ procedure fl_single_window_show
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_single_window_show, "fl_single_window_show");
+ pragma Inline (fl_single_window_show);
+
+ procedure fl_single_window_show2
+ (S : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ V : in Storage.Integer_Address);
+ pragma Import (C, fl_single_window_show2, "fl_single_window_show2");
+ pragma Inline (fl_single_window_show2);
+
+ procedure fl_single_window_flush
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_single_window_flush, "fl_single_window_flush");
+ pragma Inline (fl_single_window_flush);
+
+
+
+
+ procedure fl_single_window_make_current
+ (S : in Storage.Integer_Address);
+ pragma Import (C, fl_single_window_make_current, "fl_single_window_make_current");
+ pragma Inline (fl_single_window_make_current);
+
+
+
+
+ procedure fl_single_window_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_single_window_draw, "fl_single_window_draw");
+ pragma Inline (fl_single_window_draw);
+
+ function fl_single_window_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_single_window_handle, "fl_single_window_handle");
+ pragma Inline (fl_single_window_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Single_Window) is
+ begin
+ Extra_Final (Window (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Single_Window) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_single_window (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Single_Window;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Window (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Single_Window) is
+ begin
+ This.Draw_Ptr := fl_single_window_draw'Address;
+ This.Handle_Ptr := fl_single_window_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Single_Window is
+ begin
+ return This : Single_Window := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+
+ function Create
+ (W, H : in Integer;
+ Text : in String := "")
+ 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),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ W, H : in Integer;
+ Text : in String := "")
+ return Single_Window is
+ begin
+ return This : Single_Window := Create (W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Show
+ (This : in out Single_Window) is
+ begin
+ fl_single_window_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Show_With_Args
+ (This : in out Single_Window) is
+ begin
+ FLTK.Show_Argv.Dispatch (fl_single_window_show2'Access, This.Void_Ptr);
+ end Show_With_Args;
+
+
+ procedure Flush
+ (This : in out Single_Window) is
+ begin
+ fl_single_window_flush (This.Void_Ptr);
+ end Flush;
+
+
+
+
+ procedure Make_Current
+ (This : in out Single_Window) is
+ begin
+ fl_single_window_make_current (This.Void_Ptr);
+ end Make_Current;
+
+
+end FLTK.Widgets.Groups.Windows.Single;
+
+
diff --git a/body/fltk-widgets-groups-windows.adb b/body/fltk-widgets-groups-windows.adb
new file mode 100644
index 0000000..3a07d96
--- /dev/null
+++ b/body/fltk-widgets-groups-windows.adb
@@ -0,0 +1,792 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Command_Line,
+ Interfaces.C.Strings,
+ FLTK.Images.RGB,
+ FLTK.Show_Argv;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.unsigned,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets.Groups.Windows is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_window
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_window, "new_fl_window");
+ pragma Inline (new_fl_window);
+
+ function new_fl_window2
+ (W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_window2, "new_fl_window2");
+ pragma Inline (new_fl_window2);
+
+ procedure free_fl_window
+ (W : in Storage.Integer_Address);
+ pragma Import (C, free_fl_window, "free_fl_window");
+ pragma Inline (free_fl_window);
+
+
+
+
+ procedure fl_window_show
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_show, "fl_window_show");
+ pragma Inline (fl_window_show);
+
+ procedure fl_window_show2
+ (W : in Storage.Integer_Address;
+ C : in Interfaces.C.int;
+ V : in Storage.Integer_Address);
+ pragma Import (C, fl_window_show2, "fl_window_show2");
+ pragma Inline (fl_window_show2);
+
+ procedure fl_window_hide
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_hide, "fl_window_hide");
+ pragma Inline (fl_window_hide);
+
+ function fl_window_shown
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_window_shown, "fl_window_shown");
+ pragma Inline (fl_window_shown);
+
+ procedure fl_window_wait_for_expose
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_wait_for_expose, "fl_window_wait_for_expose");
+ pragma Inline (fl_window_wait_for_expose);
+
+ procedure fl_window_iconize
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_iconize, "fl_window_iconize");
+ pragma Inline (fl_window_iconize);
+
+ procedure fl_window_make_current
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_make_current, "fl_window_make_current");
+ pragma Inline (fl_window_make_current);
+
+ procedure fl_window_free_position
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_free_position, "fl_window_free_position");
+ pragma Inline (fl_window_free_position);
+
+
+
+
+ function fl_window_fullscreen_active
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_window_fullscreen_active, "fl_window_fullscreen_active");
+ pragma Inline (fl_window_fullscreen_active);
+
+ procedure fl_window_fullscreen
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_fullscreen, "fl_window_fullscreen");
+ pragma Inline (fl_window_fullscreen);
+
+ procedure fl_window_fullscreen_off
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_fullscreen_off, "fl_window_fullscreen_off");
+ pragma Inline (fl_window_fullscreen_off);
+
+ procedure fl_window_fullscreen_off2
+ (N : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_window_fullscreen_off2, "fl_window_fullscreen_off2");
+ pragma Inline (fl_window_fullscreen_off2);
+
+ procedure fl_window_fullscreen_screens
+ (W : in Storage.Integer_Address;
+ T, B, L, R : in Interfaces.C.int);
+ pragma Import (C, fl_window_fullscreen_screens, "fl_window_fullscreen_screens");
+ pragma Inline (fl_window_fullscreen_screens);
+
+
+
+
+ procedure fl_window_set_icon
+ (W, P : in Storage.Integer_Address);
+ pragma Import (C, fl_window_set_icon, "fl_window_set_icon");
+ pragma Inline (fl_window_set_icon);
+
+ procedure fl_window_default_icon
+ (P : in Storage.Integer_Address);
+ pragma Import (C, fl_window_default_icon, "fl_window_default_icon");
+ pragma Inline (fl_window_default_icon);
+
+ function fl_window_get_iconlabel
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_window_get_iconlabel, "fl_window_get_iconlabel");
+ pragma Inline (fl_window_get_iconlabel);
+
+ procedure fl_window_set_iconlabel
+ (W : in Storage.Integer_Address;
+ S : in Interfaces.C.char_array);
+ pragma Import (C, fl_window_set_iconlabel, "fl_window_set_iconlabel");
+ pragma Inline (fl_window_set_iconlabel);
+
+ procedure fl_window_set_cursor
+ (W : in Storage.Integer_Address;
+ C : in Interfaces.C.int);
+ pragma Import (C, fl_window_set_cursor, "fl_window_set_cursor");
+ pragma Inline (fl_window_set_cursor);
+
+ procedure fl_window_set_cursor2
+ (W, P : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_window_set_cursor2, "fl_window_set_cursor2");
+ pragma Inline (fl_window_set_cursor2);
+
+ procedure fl_window_set_default_cursor
+ (W : in Storage.Integer_Address;
+ C : in Interfaces.C.int);
+ pragma Import (C, fl_window_set_default_cursor, "fl_window_set_default_cursor");
+ pragma Inline (fl_window_set_default_cursor);
+
+
+
+
+ function fl_window_get_border
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_window_get_border, "fl_window_get_border");
+ pragma Inline (fl_window_get_border);
+
+ procedure fl_window_set_border
+ (W : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_window_set_border, "fl_window_set_border");
+ pragma Inline (fl_window_set_border);
+
+ function fl_window_get_override
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_window_get_override, "fl_window_get_override");
+ pragma Inline (fl_window_get_override);
+
+ procedure fl_window_set_override
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_set_override, "fl_window_set_override");
+ pragma Inline (fl_window_set_override);
+
+ function fl_window_modal
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_window_modal, "fl_window_modal");
+ pragma Inline (fl_window_modal);
+
+ function fl_window_non_modal
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_window_non_modal, "fl_window_non_modal");
+ pragma Inline (fl_window_non_modal);
+
+ procedure fl_window_clear_modal_states
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_clear_modal_states, "fl_window_clear_modal_states");
+ pragma Inline (fl_window_clear_modal_states);
+
+ procedure fl_window_set_modal
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_set_modal, "fl_window_set_modal");
+ pragma Inline (fl_window_set_modal);
+
+ procedure fl_window_set_non_modal
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_set_non_modal, "fl_window_set_non_modal");
+ pragma Inline (fl_window_set_non_modal);
+
+
+
+
+ function fl_window_get_label
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_window_get_label, "fl_window_get_label");
+ pragma Inline (fl_window_get_label);
+
+ procedure fl_window_set_label
+ (W : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_window_set_label, "fl_window_set_label");
+ pragma Inline (fl_window_set_label);
+
+ procedure fl_window_hotspot
+ (W : in Storage.Integer_Address;
+ X, Y, S : in Interfaces.C.int);
+ pragma Import (C, fl_window_hotspot, "fl_window_hotspot");
+ pragma Inline (fl_window_hotspot);
+
+ procedure fl_window_hotspot2
+ (W, I : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_window_hotspot2, "fl_window_hotspot2");
+ pragma Inline (fl_window_hotspot2);
+
+ procedure fl_window_size_range
+ (W : in Storage.Integer_Address;
+ LW, LH, HW, HH, DW, DH, A : in Interfaces.C.int);
+ pragma Import (C, fl_window_size_range, "fl_window_size_range");
+ pragma Inline (fl_window_size_range);
+
+ procedure fl_window_shape
+ (W, P : in Storage.Integer_Address);
+ pragma Import (C, fl_window_shape, "fl_window_shape");
+ pragma Inline (fl_window_shape);
+
+
+
+
+ function fl_window_get_x_root
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_window_get_x_root, "fl_window_get_x_root");
+ pragma Inline (fl_window_get_x_root);
+
+ function fl_window_get_y_root
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_window_get_y_root, "fl_window_get_y_root");
+ pragma Inline (fl_window_get_y_root);
+
+ function fl_window_get_decorated_w
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_window_get_decorated_w, "fl_window_get_decorated_w");
+ pragma Inline (fl_window_get_decorated_w);
+
+ function fl_window_get_decorated_h
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_window_get_decorated_h, "fl_window_get_decorated_h");
+ pragma Inline (fl_window_get_decorated_h);
+
+
+
+
+ procedure fl_window_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_window_draw, "fl_window_draw");
+ pragma Inline (fl_window_draw);
+
+ function fl_window_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_window_handle, "fl_window_handle");
+ pragma Inline (fl_window_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Window) is
+ begin
+ Extra_Final (Group (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Window) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_window (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Window;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Window) is
+ begin
+ This.Draw_Ptr := fl_window_draw'Address;
+ This.Handle_Ptr := fl_window_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Window is
+ begin
+ return This : Window := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+
+ function Create
+ (W, H : in Integer;
+ Text : in String := "")
+ return Window is
+ begin
+ return This : Window do
+ This.Void_Ptr := new_fl_window2
+ (Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, This.Get_X, This.Get_Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ W, H : in Integer;
+ Text : in String := "")
+ return Window is
+ begin
+ return This : Window := Create (W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Show
+ (This : in out Window) is
+ begin
+ fl_window_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Show_With_Args
+ (This : in out Window) is
+ begin
+ FLTK.Show_Argv.Dispatch (fl_window_show2'Access, This.Void_Ptr);
+ end Show_With_Args;
+
+
+ procedure Hide
+ (This : in out Window) is
+ begin
+ fl_window_hide (This.Void_Ptr);
+ end Hide;
+
+
+ function Is_Shown
+ (This : in Window)
+ return Boolean is
+ begin
+ return fl_window_shown (This.Void_Ptr) /= 0;
+ end Is_Shown;
+
+
+ procedure Wait_For_Expose
+ (This : in out Window) is
+ begin
+ fl_window_wait_for_expose (This.Void_Ptr);
+ end Wait_For_Expose;
+
+
+ procedure Iconify
+ (This : in out Window) is
+ begin
+ fl_window_iconize (This.Void_Ptr);
+ end Iconify;
+
+
+ procedure Make_Current
+ (This : in out Window) is
+ begin
+ fl_window_make_current (This.Void_Ptr);
+ Last_Current := This'Unchecked_Access;
+ end Make_Current;
+
+
+ function Last_Made_Current
+ return access Window'Class is
+ begin
+ return Last_Current;
+ end Last_Made_Current;
+
+
+ procedure Free_Position
+ (This : in out Window) is
+ begin
+ fl_window_free_position (This.Void_Ptr);
+ end Free_Position;
+
+
+
+
+ function Is_Fullscreen
+ (This : in Window)
+ return Boolean is
+ begin
+ return fl_window_fullscreen_active (This.Void_Ptr) /= 0;
+ end Is_Fullscreen;
+
+
+ procedure Fullscreen_On
+ (This : in out Window) is
+ begin
+ fl_window_fullscreen (This.Void_Ptr);
+ end Fullscreen_On;
+
+
+ procedure Fullscreen_Off
+ (This : in out Window) is
+ begin
+ fl_window_fullscreen_off (This.Void_Ptr);
+ end Fullscreen_Off;
+
+
+ procedure Fullscreen_Off
+ (This : in out Window;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_window_fullscreen_off2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Fullscreen_Off;
+
+
+ procedure Fullscreen_Screens
+ (This : in out Window;
+ Top, Bottom, Left, Right : in Natural) is
+ begin
+ fl_window_fullscreen_screens
+ (This.Void_Ptr,
+ Interfaces.C.int (Top),
+ Interfaces.C.int (Bottom),
+ Interfaces.C.int (Left),
+ Interfaces.C.int (Right));
+ end Fullscreen_Screens;
+
+
+
+
+ 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_Default_Icon
+ (Pic : in out FLTK.Images.RGB.RGB_Image'Class) is
+ begin
+ fl_window_default_icon (Wrapper (Pic).Void_Ptr);
+ end Set_Default_Icon;
+
+
+ function Get_Icon_Label
+ (This : in Window)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_window_get_iconlabel (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ -- pointer to internal buffer only, so no Free required
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Get_Icon_Label;
+
+
+ procedure Set_Icon_Label
+ (This : in out Window;
+ To : in String) is
+ begin
+ fl_window_set_iconlabel (This.Void_Ptr, Interfaces.C.To_C (To));
+ end Set_Icon_Label;
+
+
+ procedure Set_Cursor
+ (This : in out Window;
+ To : in Mouse_Cursor_Kind) is
+ begin
+ fl_window_set_cursor (This.Void_Ptr, Cursor_Values (To));
+ end Set_Cursor;
+
+
+ procedure Set_Cursor
+ (This : in out Window;
+ Pic : in out FLTK.Images.RGB.RGB_Image'Class;
+ Hot_X, Hot_Y : in Integer) is
+ begin
+ fl_window_set_cursor2
+ (This.Void_Ptr,
+ Wrapper (Pic).Void_Ptr,
+ Interfaces.C.int (Hot_X),
+ Interfaces.C.int (Hot_Y));
+ end Set_Cursor;
+
+
+ procedure Set_Default_Cursor
+ (This : in out Window;
+ To : in Mouse_Cursor_Kind) is
+ begin
+ fl_window_set_default_cursor (This.Void_Ptr, Cursor_Values (To));
+ end Set_Default_Cursor;
+
+
+
+
+ function Get_Border_State
+ (This : in Window)
+ return Border_State is
+ begin
+ return Border_State'Val (fl_window_get_border (This.Void_Ptr));
+ end Get_Border_State;
+
+
+ procedure Set_Border_State
+ (This : in out Window;
+ To : in Border_State) is
+ begin
+ fl_window_set_border (This.Void_Ptr, Border_State'Pos (To));
+ end Set_Border_State;
+
+
+ function Is_Override
+ (This : in Window)
+ return Boolean is
+ begin
+ return fl_window_get_override (This.Void_Ptr) /= 0;
+ end Is_Override;
+
+
+ procedure Set_Override
+ (This : in out Window) is
+ begin
+ fl_window_set_override (This.Void_Ptr);
+ end Set_Override;
+
+
+ function Get_Modal_State
+ (This : in Window)
+ return Modal_State is
+ begin
+ if fl_window_modal (This.Void_Ptr) /= 0 then
+ return Modal;
+ elsif fl_window_non_modal (This.Void_Ptr) /= 0 then
+ return Non_Modal;
+ else
+ return Normal;
+ end if;
+ end Get_Modal_State;
+
+
+ procedure Set_Modal_State
+ (This : in out Window;
+ To : in Modal_State) is
+ begin
+ case To is
+ when Normal =>
+ fl_window_clear_modal_states (This.Void_Ptr);
+ when Non_Modal =>
+ fl_window_set_non_modal (This.Void_Ptr);
+ when Modal =>
+ fl_window_set_modal (This.Void_Ptr);
+ end case;
+ end Set_Modal_State;
+
+
+
+
+ function Get_Label
+ (This : in Window)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_window_get_label (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ -- pointer to internal buffer only, so no Free required
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Get_Label;
+
+
+ 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 Hotspot
+ (This : in out Window;
+ X, Y : in Integer;
+ Offscreen : in Boolean := False) is
+ begin
+ fl_window_hotspot
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Boolean'Pos (Offscreen));
+ end Hotspot;
+
+
+ procedure Hotspot
+ (This : in out Window;
+ Item : in Widget'Class;
+ Offscreen : in Boolean := False) is
+ begin
+ fl_window_hotspot2
+ (This.Void_Ptr,
+ Item.Void_Ptr,
+ Boolean'Pos (Offscreen));
+ end Hotspot;
+
+
+ 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 Shape
+ (This : in out Window;
+ Pic : in out FLTK.Images.Image'Class) is
+ begin
+ fl_window_shape (This.Void_Ptr, Wrapper (Pic).Void_Ptr);
+ end Shape;
+
+
+
+
+ function Get_X_Root
+ (This : in Window)
+ return Integer is
+ begin
+ return Integer (fl_window_get_x_root (This.Void_Ptr));
+ end Get_X_Root;
+
+
+ function Get_Y_Root
+ (This : in Window)
+ return Integer is
+ begin
+ return Integer (fl_window_get_y_root (This.Void_Ptr));
+ end Get_Y_Root;
+
+
+ function Get_Decorated_W
+ (This : in Window)
+ return Integer is
+ begin
+ return Integer (fl_window_get_decorated_w (This.Void_Ptr));
+ end Get_Decorated_W;
+
+
+ function Get_Decorated_H
+ (This : in Window)
+ return Integer is
+ begin
+ return Integer (fl_window_get_decorated_h (This.Void_Ptr));
+ end Get_Decorated_H;
+
+
+
+
+ procedure Draw
+ (This : in out Window) is
+ begin
+ Group (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Window;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Group (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Groups.Windows;
+
+
diff --git a/body/fltk-widgets-groups-wizards.adb b/body/fltk-widgets-groups-wizards.adb
new file mode 100644
index 0000000..eb604a1
--- /dev/null
+++ b/body/fltk-widgets-groups-wizards.adb
@@ -0,0 +1,219 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Groups.Wizards is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_wizard
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_wizard, "new_fl_wizard");
+ pragma Inline (new_fl_wizard);
+
+ procedure free_fl_wizard
+ (S : in Storage.Integer_Address);
+ pragma Import (C, free_fl_wizard, "free_fl_wizard");
+ pragma Inline (free_fl_wizard);
+
+
+
+
+ procedure fl_wizard_next
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_wizard_next, "fl_wizard_next");
+ pragma Inline (fl_wizard_next);
+
+ procedure fl_wizard_prev
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_wizard_prev, "fl_wizard_prev");
+ pragma Inline (fl_wizard_prev);
+
+
+
+
+ function fl_wizard_get_visible
+ (W : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_wizard_get_visible, "fl_wizard_get_visible");
+ pragma Inline (fl_wizard_get_visible);
+
+ procedure fl_wizard_set_visible
+ (W, I : in Storage.Integer_Address);
+ pragma Import (C, fl_wizard_set_visible, "fl_wizard_set_visible");
+ pragma Inline (fl_wizard_set_visible);
+
+
+
+
+ procedure fl_wizard_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_wizard_draw, "fl_wizard_draw");
+ pragma Inline (fl_wizard_draw);
+
+ function fl_wizard_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_wizard_handle, "fl_wizard_handle");
+ pragma Inline (fl_wizard_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Wizard) is
+ begin
+ Extra_Final (Group (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Wizard) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_wizard (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Wizard;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Group (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Wizard) is
+ begin
+ This.Draw_Ptr := fl_wizard_draw'Address;
+ This.Handle_Ptr := fl_wizard_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Wizard is
+ begin
+ return This : Wizard do
+ This.Void_Ptr := new_fl_wizard
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Wizard is
+ begin
+ return This : Wizard := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Next
+ (This : in out Wizard) is
+ begin
+ fl_wizard_next (This.Void_Ptr);
+ end Next;
+
+
+ procedure Prev
+ (This : in out Wizard) is
+ begin
+ fl_wizard_prev (This.Void_Ptr);
+ end Prev;
+
+
+
+
+ function Get_Visible
+ (This : in Wizard)
+ return access Widget'Class
+ is
+ Visible_Ptr : Storage.Integer_Address := fl_wizard_get_visible (This.Void_Ptr);
+ Actual_Widget : access Widget'Class;
+ begin
+ if Visible_Ptr /= Null_Pointer then
+ Visible_Ptr := fl_widget_get_user_data (Visible_Ptr);
+ pragma Assert (Visible_Ptr /= Null_Pointer);
+ Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Visible_Ptr));
+ end if;
+ return Actual_Widget;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Visible;
+
+
+ procedure Set_Visible
+ (This : in out Wizard;
+ Item : in out Widget'Class) is
+ begin
+ fl_wizard_set_visible (This.Void_Ptr, Item.Void_Ptr);
+ end Set_Visible;
+
+
+
+
+ procedure Draw
+ (This : in out Wizard) is
+ begin
+ Group (This).Draw;
+ end Draw;
+
+
+end FLTK.Widgets.Groups.Wizards;
+
+
diff --git a/body/fltk-widgets-groups.adb b/body/fltk-widgets-groups.adb
new file mode 100644
index 0000000..e7c8780
--- /dev/null
+++ b/body/fltk-widgets-groups.adb
@@ -0,0 +1,637 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Groups is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_group
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_group, "new_fl_group");
+ pragma Inline (new_fl_group);
+
+ procedure free_fl_group
+ (G : in Storage.Integer_Address);
+ pragma Import (C, free_fl_group, "free_fl_group");
+ pragma Inline (free_fl_group);
+
+
+
+
+ procedure fl_group_add
+ (G, W : in Storage.Integer_Address);
+ pragma Import (C, fl_group_add, "fl_group_add");
+ pragma Inline (fl_group_add);
+
+ procedure fl_group_insert
+ (G, W : in Storage.Integer_Address;
+ P : in Interfaces.C.int);
+ pragma Import (C, fl_group_insert, "fl_group_insert");
+ pragma Inline (fl_group_insert);
+
+ procedure fl_group_insert2
+ (G, W, B : in Storage.Integer_Address);
+ pragma Import (C, fl_group_insert2, "fl_group_insert2");
+ pragma Inline (fl_group_insert2);
+
+ procedure fl_group_remove
+ (G, W : in Storage.Integer_Address);
+ pragma Import (C, fl_group_remove, "fl_group_remove");
+ pragma Inline (fl_group_remove);
+
+ procedure fl_group_remove2
+ (G : in Storage.Integer_Address;
+ P : in Interfaces.C.int);
+ pragma Import (C, fl_group_remove2, "fl_group_remove2");
+ pragma Inline (fl_group_remove2);
+
+
+
+
+ function fl_group_child
+ (G : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_group_child, "fl_group_child");
+ pragma Inline (fl_group_child);
+
+ function fl_group_find
+ (G, W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_group_find, "fl_group_find");
+ pragma Inline (fl_group_find);
+
+ function fl_group_children
+ (G : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_group_children, "fl_group_children");
+ pragma Inline (fl_group_children);
+
+
+
+
+ function fl_group_get_clip_children
+ (G : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_group_get_clip_children, "fl_group_get_clip_children");
+ pragma Inline (fl_group_get_clip_children);
+
+ procedure fl_group_set_clip_children
+ (G : in Storage.Integer_Address;
+ C : in Interfaces.C.int);
+ pragma Import (C, fl_group_set_clip_children, "fl_group_set_clip_children");
+ pragma Inline (fl_group_set_clip_children);
+
+
+
+
+ procedure fl_group_add_resizable
+ (G, W : in Storage.Integer_Address);
+ pragma Import (C, fl_group_add_resizable, "fl_group_add_resizable");
+ pragma Inline (fl_group_add_resizable);
+
+ function fl_group_get_resizable
+ (G : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_group_get_resizable, "fl_group_get_resizable");
+ pragma Inline (fl_group_get_resizable);
+
+ procedure fl_group_set_resizable
+ (G, W : in Storage.Integer_Address);
+ pragma Import (C, fl_group_set_resizable, "fl_group_set_resizable");
+ pragma Inline (fl_group_set_resizable);
+
+ procedure fl_group_init_sizes
+ (G : in Storage.Integer_Address);
+ pragma Import (C, fl_group_init_sizes, "fl_group_init_sizes");
+ pragma Inline (fl_group_init_sizes);
+
+ procedure fl_group_resize
+ (G : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_group_resize, "fl_group_resize");
+ pragma Inline (fl_group_resize);
+
+
+
+
+ function fl_group_get_current
+ return Storage.Integer_Address;
+ pragma Import (C, fl_group_get_current, "fl_group_get_current");
+ pragma Inline (fl_group_get_current);
+
+ procedure fl_group_set_current
+ (G : in Storage.Integer_Address);
+ pragma Import (C, fl_group_set_current, "fl_group_set_current");
+ pragma Inline (fl_group_set_current);
+
+ procedure fl_group_begin
+ (G : in Storage.Integer_Address);
+ pragma Import (C, fl_group_begin, "fl_group_begin");
+ pragma Inline (fl_group_begin);
+
+ procedure fl_group_end
+ (G : in Storage.Integer_Address);
+ pragma Import (C, fl_group_end, "fl_group_end");
+ pragma Inline (fl_group_end);
+
+
+
+
+ procedure fl_group_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_group_draw, "fl_group_draw");
+ pragma Inline (fl_group_draw);
+
+ procedure fl_group_draw_child
+ (G, W : in Storage.Integer_Address);
+ pragma Import (C, fl_group_draw_child, "fl_group_draw_child");
+ pragma Inline (fl_group_draw_child);
+
+ procedure fl_group_draw_children
+ (G : in Storage.Integer_Address);
+ pragma Import (C, fl_group_draw_children, "fl_group_draw_children");
+ pragma Inline (fl_group_draw_children);
+
+ procedure fl_group_draw_outside_label
+ (G, W : in Storage.Integer_Address);
+ pragma Import (C, fl_group_draw_outside_label, "fl_group_draw_outside_label");
+ pragma Inline (fl_group_draw_outside_label);
+
+ procedure fl_group_update_child
+ (G, W : in Storage.Integer_Address);
+ pragma Import (C, fl_group_update_child, "fl_group_update_child");
+ pragma Inline (fl_group_update_child);
+
+ function fl_group_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_group_handle, "fl_group_handle");
+ pragma Inline (fl_group_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Group) is
+ begin
+ This.Clear;
+ Extra_Final (Widget (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Group) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_group (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Group;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ fl_group_end (This.Void_Ptr);
+ Extra_Init (Widget (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Group) is
+ begin
+ This.Draw_Ptr := fl_group_draw'Address;
+ This.Handle_Ptr := fl_group_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Group is
+ begin
+ return This : Group := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Add
+ (This : in out Group;
+ Item : in out Widget'Class) is
+ begin
+ fl_group_add (This.Void_Ptr, Item.Void_Ptr);
+ end Add;
+
+
+ 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) - 1);
+ end Insert;
+
+
+ procedure Insert
+ (This : in out Group;
+ Item : in out Widget'Class;
+ Before : in Widget'Class) is
+ begin
+ fl_group_insert2
+ (This.Void_Ptr,
+ Item.Void_Ptr,
+ Before.Void_Ptr);
+ 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) - 1);
+ end Remove;
+
+
+ procedure Clear
+ (This : in out Group) is
+ begin
+ -- We don't use the actual clear method here because
+ -- that would delete the children from memory.
+ for I in reverse 1 .. This.Number_Of_Children loop
+ This.Remove (Index (I));
+ end loop;
+ end Clear;
+
+
+
+
+ function Has_Child
+ (This : in Group;
+ Place : in Index)
+ return Boolean is
+ begin
+ return Place in 1 .. This.Number_Of_Children;
+ end Has_Child;
+
+
+ function Has_Child
+ (Place : in Cursor)
+ return Boolean is
+ begin
+ return Place.My_Container.Has_Child (Place.My_Index);
+ end Has_Child;
+
+
+ function Child
+ (This : in Group;
+ Place : in Index)
+ return Widget_Reference
+ is
+ Widget_Ptr : Storage.Integer_Address :=
+ fl_group_child (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+ Actual_Widget : access Widget'Class;
+ begin
+ Widget_Ptr := fl_widget_get_user_data (Widget_Ptr);
+ pragma Assert (Widget_Ptr /= Null_Pointer);
+ Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Widget_Ptr));
+ return (Data => Actual_Widget);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Child;
+
+
+ function Child
+ (This : in Group;
+ Place : in Cursor)
+ return Widget_Reference is
+ begin
+ return This.Child (Place.My_Index);
+ end Child;
+
+
+ function Find
+ (This : in Group;
+ Item : in out Widget'Class)
+ return Extended_Index
+ is
+ Result : Interfaces.C.int := fl_group_find (This.Void_Ptr, Item.Void_Ptr);
+ begin
+ if Result = fl_group_children (This.Void_Ptr) then
+ return No_Index;
+ end if;
+ return Extended_Index (Result + 1);
+ end Find;
+
+
+ function Number_Of_Children
+ (This : in Group)
+ return Natural is
+ begin
+ return Natural (fl_group_children (This.Void_Ptr));
+ end Number_Of_Children;
+
+
+
+
+ function Iterate
+ (This : in Group)
+ return Group_Iterators.Reversible_Iterator'Class is
+ begin
+ return It : Iterator := (My_Container => This'Unrestricted_Access);
+ end Iterate;
+
+
+ function First
+ (Object : in Iterator)
+ return Cursor is
+ begin
+ return Cu : Cursor :=
+ (My_Container => Object.My_Container,
+ My_Index => 1);
+ end First;
+
+
+ function Next
+ (Object : in Iterator;
+ Place : in Cursor)
+ return Cursor is
+ begin
+ if Object.My_Container /= Place.My_Container then
+ raise Program_Error;
+ end if;
+ return Cu : Cursor :=
+ (My_Container => Place.My_Container,
+ My_Index => Place.My_Index + 1);
+ end Next;
+
+
+ function Last
+ (Object : in Iterator)
+ return Cursor is
+ begin
+ return Cu : Cursor :=
+ (My_Container => Object.My_Container,
+ My_Index => Object.My_Container.Number_Of_Children);
+ end Last;
+
+
+ function Previous
+ (Object : in Iterator;
+ Place : in Cursor)
+ return Cursor is
+ begin
+ if Object.My_Container /= Place.My_Container then
+ raise Program_Error;
+ end if;
+ return Cu : Cursor :=
+ (My_Container => Place.My_Container,
+ My_Index => Place.My_Index - 1);
+ end Previous;
+
+
+
+
+ function Get_Clip_Mode
+ (This : in Group)
+ return Clip_Mode is
+ begin
+ return Clip_Mode'Val (fl_group_get_clip_children (This.Void_Ptr));
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error;
+ end Get_Clip_Mode;
+
+
+ procedure Set_Clip_Mode
+ (This : in out Group;
+ Mode : in Clip_Mode := Clip) is
+ begin
+ fl_group_set_clip_children (This.Void_Ptr, Clip_Mode'Pos (Mode));
+ end Set_Clip_Mode;
+
+
+
+
+ procedure Add_Resizable
+ (This : in out Group;
+ Item : in out Widget'Class) is
+ begin
+ fl_group_add_resizable (This.Void_Ptr, Item.Void_Ptr);
+ end Add_Resizable;
+
+
+ function Get_Resizable
+ (This : in Group)
+ return access Widget'Class
+ is
+ Widget_Ptr : Storage.Integer_Address := fl_group_get_resizable (This.Void_Ptr);
+ Actual_Widget : access Widget'Class;
+ begin
+ if Widget_Ptr /= Null_Pointer then
+ Widget_Ptr := fl_widget_get_user_data (Widget_Ptr);
+ pragma Assert (Widget_Ptr /= Null_Pointer);
+ Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Widget_Ptr));
+ end if;
+ return Actual_Widget;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Resizable;
+
+
+ procedure Set_Resizable
+ (This : in out Group;
+ Item : in Widget'Class) is
+ begin
+ fl_group_set_resizable (This.Void_Ptr, Item.Void_Ptr);
+ end Set_Resizable;
+
+
+ procedure Reset_Sizes
+ (This : in out Group) is
+ begin
+ fl_group_init_sizes (This.Void_Ptr);
+ end Reset_Sizes;
+
+
+ procedure Resize
+ (This : in out Group;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_group_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+
+
+ function Get_Current
+ return access Group'Class
+ is
+ Group_Ptr : Storage.Integer_Address := fl_group_get_current;
+ Actual_Group : access Group'Class;
+ begin
+ if Group_Ptr /= Null_Pointer then
+ Group_Ptr := fl_widget_get_user_data (Group_Ptr);
+ pragma Assert (Group_Ptr /= Null_Pointer);
+ Actual_Group := Group_Convert.To_Pointer (Storage.To_Address (Group_Ptr));
+ end if;
+ return Actual_Group;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Get_Current;
+
+
+ procedure Set_Current
+ (To : in Group'Class) is
+ begin
+ fl_group_set_current (To.Void_Ptr);
+ end Set_Current;
+
+
+ procedure Begin_Current
+ (This : in out Group) is
+ begin
+ fl_group_begin (This.Void_Ptr);
+ end Begin_Current;
+
+
+ procedure End_Current
+ (This : in out Group) is
+ begin
+ fl_group_end (This.Void_Ptr);
+ end End_Current;
+
+
+
+
+ procedure Draw
+ (This : in out Group) is
+ begin
+ Widget (This).Draw;
+ end Draw;
+
+
+ procedure Draw_Child
+ (This : in out Group;
+ Item : in out Widget'Class) is
+ begin
+ fl_group_draw_child (This.Void_Ptr, Item.Void_Ptr);
+ end Draw_Child;
+
+
+ procedure Draw_Children
+ (This : in out Group) is
+ begin
+ fl_group_draw_children (This.Void_Ptr);
+ end Draw_Children;
+
+
+ procedure Draw_Outside_Label
+ (This : in out Group;
+ Item : in out Widget'Class) is
+ begin
+ fl_group_draw_outside_label (This.Void_Ptr, Item.Void_Ptr);
+ end Draw_Outside_Label;
+
+
+ procedure Update_Child
+ (This : in out Group;
+ Item : in out Widget'Class) is
+ begin
+ fl_group_update_child (This.Void_Ptr, Item.Void_Ptr);
+ end Update_Child;
+
+
+ function Handle
+ (This : in out Group;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Widget (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Groups;
+
+
diff --git a/body/fltk-widgets-inputs-text-file.adb b/body/fltk-widgets-inputs-text-file.adb
new file mode 100644
index 0000000..c7e4919
--- /dev/null
+++ b/body/fltk-widgets-inputs-text-file.adb
@@ -0,0 +1,272 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets.Inputs.Text.File is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_file_input
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_file_input, "new_fl_file_input");
+ pragma Inline (new_fl_file_input);
+
+ procedure free_fl_file_input
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_file_input, "free_fl_file_input");
+ pragma Inline (free_fl_file_input);
+
+
+
+
+ function fl_file_input_get_down_box
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_input_get_down_box, "fl_file_input_get_down_box");
+ pragma Inline (fl_file_input_get_down_box);
+
+ procedure fl_file_input_set_down_box
+ (F : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_file_input_set_down_box, "fl_file_input_set_down_box");
+ pragma Inline (fl_file_input_set_down_box);
+
+ function fl_file_input_get_errorcolor
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_file_input_get_errorcolor, "fl_file_input_get_errorcolor");
+ pragma Inline (fl_file_input_get_errorcolor);
+
+ procedure fl_file_input_set_errorcolor
+ (F : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned);
+ pragma Import (C, fl_file_input_set_errorcolor, "fl_file_input_set_errorcolor");
+ pragma Inline (fl_file_input_set_errorcolor);
+
+
+
+
+ function fl_file_input_get_value
+ (F : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_file_input_get_value, "fl_file_input_get_value");
+ pragma Inline (fl_file_input_get_value);
+
+ function fl_file_input_set_value
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array;
+ L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_input_set_value, "fl_file_input_set_value");
+ pragma Inline (fl_file_input_set_value);
+
+
+
+
+ procedure fl_file_input_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_file_input_draw, "fl_file_input_draw");
+ pragma Inline (fl_file_input_draw);
+
+ function fl_file_input_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_file_input_handle, "fl_file_input_handle");
+ pragma Inline (fl_file_input_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out File_Input) is
+ begin
+ Extra_Final (Input (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out File_Input) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_file_input (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out File_Input;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Input (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out File_Input) is
+ begin
+ This.Draw_Ptr := fl_file_input_draw'Address;
+ This.Handle_Ptr := fl_file_input_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return File_Input is
+ begin
+ return This : File_Input do
+ This.Void_Ptr := new_fl_file_input
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return File_Input is
+ begin
+ return This : File_Input := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Down_Box
+ (This : in File_Input)
+ return Box_Kind is
+ begin
+ return Box_Kind'Val (fl_file_input_get_down_box (This.Void_Ptr));
+ end Get_Down_Box;
+
+
+ procedure Set_Down_Box
+ (This : in out File_Input;
+ To : in Box_Kind) is
+ begin
+ fl_file_input_set_down_box (This.Void_Ptr, Box_Kind'Pos (To));
+ end Set_Down_Box;
+
+
+ function Get_Error_Color
+ (This : in File_Input)
+ return Color is
+ begin
+ return Color (fl_file_input_get_errorcolor (This.Void_Ptr));
+ end Get_Error_Color;
+
+
+ procedure Set_Error_Color
+ (This : in out File_Input;
+ To : in Color) is
+ begin
+ fl_file_input_set_errorcolor (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Error_Color;
+
+
+
+
+ function Get_Value
+ (This : in File_Input)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_file_input_get_value (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ -- pointer to internal buffer only, so no Free required
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Get_Value;
+
+
+ procedure Set_Value
+ (This : in out File_Input;
+ To : in String)
+ is
+ Result : Interfaces.C.int := fl_file_input_set_value
+ (This.Void_Ptr,
+ Interfaces.C.To_C (To), To'Length);
+ begin
+ pragma Assert (Result /= 0);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Set_Value;
+
+
+
+
+ procedure Draw
+ (This : in out File_Input) is
+ begin
+ Text_Input (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out File_Input;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Text_Input (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Inputs.Text.File;
+
+
diff --git a/body/fltk-widgets-inputs-text-floating_point.adb b/body/fltk-widgets-inputs-text-floating_point.adb
new file mode 100644
index 0000000..c7982d2
--- /dev/null
+++ b/body/fltk-widgets-inputs-text-floating_point.adb
@@ -0,0 +1,156 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets.Inputs.Text.Floating_Point is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_float_input
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_float_input, "new_fl_float_input");
+ pragma Inline (new_fl_float_input);
+
+ procedure free_fl_float_input
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_float_input, "free_fl_float_input");
+ pragma Inline (free_fl_float_input);
+
+
+
+
+ procedure fl_float_input_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_float_input_draw, "fl_float_input_draw");
+ pragma Inline (fl_float_input_draw);
+
+ function fl_float_input_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_float_input_handle, "fl_float_input_handle");
+ pragma Inline (fl_float_input_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Float_Input) is
+ begin
+ Extra_Final (Input (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Float_Input) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_float_input (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Float_Input;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Input (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Float_Input) is
+ begin
+ This.Draw_Ptr := fl_float_input_draw'Address;
+ This.Handle_Ptr := fl_float_input_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Float_Input is
+ begin
+ return This : Float_Input do
+ This.Void_Ptr := new_fl_float_input
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Float_Input is
+ begin
+ return This : Float_Input := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Value
+ (This : in Float_Input)
+ return Long_Float
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr or else
+ Interfaces.C.Strings.Value (Ptr) = ""
+ then
+ return 0.0;
+ else
+ return Long_Float'Value (Interfaces.C.Strings.Value (Ptr));
+ end if;
+ end Get_Value;
+
+
+end FLTK.Widgets.Inputs.Text.Floating_Point;
+
+
diff --git a/body/fltk-widgets-inputs-text-multiline.adb b/body/fltk-widgets-inputs-text-multiline.adb
new file mode 100644
index 0000000..27e0def
--- /dev/null
+++ b/body/fltk-widgets-inputs-text-multiline.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Inputs.Text.Multiline is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_multiline_input
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_multiline_input, "new_fl_multiline_input");
+ pragma Inline (new_fl_multiline_input);
+
+ procedure free_fl_multiline_input
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_multiline_input, "free_fl_multiline_input");
+ pragma Inline (free_fl_multiline_input);
+
+
+
+
+ procedure fl_multiline_input_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_multiline_input_draw, "fl_multiline_input_draw");
+ pragma Inline (fl_multiline_input_draw);
+
+ function fl_multiline_input_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_multiline_input_handle, "fl_multiline_input_handle");
+ pragma Inline (fl_multiline_input_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Multiline_Input) is
+ begin
+ Extra_Final (Input (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Multiline_Input) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_multiline_input (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Multiline_Input;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Input (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Multiline_Input) is
+ begin
+ This.Draw_Ptr := fl_multiline_input_draw'Address;
+ This.Handle_Ptr := fl_multiline_input_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Multiline_Input is
+ begin
+ return This : Multiline_Input do
+ This.Void_Ptr := new_fl_multiline_input
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Multiline_Input is
+ begin
+ return This : Multiline_Input := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Inputs.Text.Multiline;
+
+
diff --git a/body/fltk-widgets-inputs-text-outputs-multiline.adb b/body/fltk-widgets-inputs-text-outputs-multiline.adb
new file mode 100644
index 0000000..4d8ade8
--- /dev/null
+++ b/body/fltk-widgets-inputs-text-outputs-multiline.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Inputs.Text.Outputs.Multiline is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_multiline_output
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_multiline_output, "new_fl_multiline_output");
+ pragma Inline (new_fl_multiline_output);
+
+ procedure free_fl_multiline_output
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_multiline_output, "free_fl_multiline_output");
+ pragma Inline (free_fl_multiline_output);
+
+
+
+
+ procedure fl_multiline_output_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_multiline_output_draw, "fl_multiline_output_draw");
+ pragma Inline (fl_multiline_output_draw);
+
+ function fl_multiline_output_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_multiline_output_handle, "fl_multiline_output_handle");
+ pragma Inline (fl_multiline_output_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Multiline_Output) is
+ begin
+ Extra_Final (Output (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Multiline_Output) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_multiline_output (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Multiline_Output;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Output (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Multiline_Output) is
+ begin
+ This.Draw_Ptr := fl_multiline_output_draw'Address;
+ This.Handle_Ptr := fl_multiline_output_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Multiline_Output is
+ begin
+ return This : Multiline_Output do
+ This.Void_Ptr := new_fl_multiline_output
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Multiline_Output is
+ begin
+ return This : Multiline_Output := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Inputs.Text.Outputs.Multiline;
+
+
diff --git a/body/fltk-widgets-inputs-text-outputs.adb b/body/fltk-widgets-inputs-text-outputs.adb
new file mode 100644
index 0000000..48e697f
--- /dev/null
+++ b/body/fltk-widgets-inputs-text-outputs.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Inputs.Text.Outputs is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_output
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_output, "new_fl_output");
+ pragma Inline (new_fl_output);
+
+ procedure free_fl_output
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_output, "free_fl_output");
+ pragma Inline (free_fl_output);
+
+
+
+
+ procedure fl_output_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_output_draw, "fl_output_draw");
+ pragma Inline (fl_output_draw);
+
+ function fl_output_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_output_handle, "fl_output_handle");
+ pragma Inline (fl_output_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Output) is
+ begin
+ Extra_Final (Input (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Output) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_output (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Output;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Input (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Output) is
+ begin
+ This.Draw_Ptr := fl_output_draw'Address;
+ This.Handle_Ptr := fl_output_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Output is
+ begin
+ return This : Output do
+ This.Void_Ptr := new_fl_output
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Output is
+ begin
+ return This : Output := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Inputs.Text.Outputs;
+
+
diff --git a/body/fltk-widgets-inputs-text-secret.adb b/body/fltk-widgets-inputs-text-secret.adb
new file mode 100644
index 0000000..ab821d4
--- /dev/null
+++ b/body/fltk-widgets-inputs-text-secret.adb
@@ -0,0 +1,145 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Inputs.Text.Secret is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_secret_input
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_secret_input, "new_fl_secret_input");
+ pragma Inline (new_fl_secret_input);
+
+ procedure free_fl_secret_input
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_secret_input, "free_fl_secret_input");
+ pragma Inline (free_fl_secret_input);
+
+
+
+
+ procedure fl_secret_input_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_secret_input_draw, "fl_secret_input_draw");
+ pragma Inline (fl_secret_input_draw);
+
+ function fl_secret_input_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_secret_input_handle, "fl_secret_input_handle");
+ pragma Inline (fl_secret_input_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Secret_Input) is
+ begin
+ Extra_Final (Input (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Secret_Input) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_secret_input (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Secret_Input;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Input (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Secret_Input) is
+ begin
+ This.Draw_Ptr := fl_secret_input_draw'Address;
+ This.Handle_Ptr := fl_secret_input_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Secret_Input is
+ begin
+ return This : Secret_Input do
+ This.Void_Ptr := new_fl_secret_input
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Secret_Input is
+ begin
+ return This : Secret_Input := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Handle
+ (This : in out Secret_Input;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Text_Input (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Inputs.Text.Secret;
+
+
diff --git a/body/fltk-widgets-inputs-text-whole_number.adb b/body/fltk-widgets-inputs-text-whole_number.adb
new file mode 100644
index 0000000..e5b0f85
--- /dev/null
+++ b/body/fltk-widgets-inputs-text-whole_number.adb
@@ -0,0 +1,156 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets.Inputs.Text.Whole_Number is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_int_input
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_int_input, "new_fl_int_input");
+ pragma Inline (new_fl_int_input);
+
+ procedure free_fl_int_input
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_int_input, "free_fl_int_input");
+ pragma Inline (free_fl_int_input);
+
+
+
+
+ procedure fl_int_input_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_int_input_draw, "fl_int_input_draw");
+ pragma Inline (fl_int_input_draw);
+
+ function fl_int_input_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_int_input_handle, "fl_int_input_handle");
+ pragma Inline (fl_int_input_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Integer_Input) is
+ begin
+ Extra_Final (Input (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Integer_Input) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_int_input (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Integer_Input;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Input (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Integer_Input) is
+ begin
+ This.Draw_Ptr := fl_int_input_draw'Address;
+ This.Handle_Ptr := fl_int_input_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Integer_Input is
+ begin
+ return This : Integer_Input := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Value
+ (This : in Integer_Input)
+ return Long_Integer
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr or else
+ Interfaces.C.Strings.Value (Ptr) = ""
+ then
+ return 0;
+ else
+ return Long_Integer'Value (Interfaces.C.Strings.Value (Ptr));
+ end if;
+ end Get_Value;
+
+
+end FLTK.Widgets.Inputs.Text.Whole_Number;
+
+
diff --git a/body/fltk-widgets-inputs-text.adb b/body/fltk-widgets-inputs-text.adb
new file mode 100644
index 0000000..efed39c
--- /dev/null
+++ b/body/fltk-widgets-inputs-text.adb
@@ -0,0 +1,192 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Inputs.Text is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_text_input
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_text_input, "new_fl_text_input");
+ pragma Inline (new_fl_text_input);
+
+ procedure free_fl_text_input
+ (T : in Storage.Integer_Address);
+ pragma Import (C, free_fl_text_input, "free_fl_text_input");
+ pragma Inline (free_fl_text_input);
+
+
+
+
+ procedure fl_text_input_draw
+ (T : in Storage.Integer_Address);
+ pragma Import (C, fl_text_input_draw, "fl_text_input_draw");
+ pragma Inline (fl_text_input_draw);
+
+ function fl_text_input_handle
+ (T : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_text_input_handle, "fl_text_input_handle");
+ pragma Inline (fl_text_input_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ -- Message received, every zig will take off
+ procedure text_input_extra_final_hook
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Export (C, text_input_extra_final_hook, "text_input_extra_final_hook");
+
+ procedure text_input_extra_final_hook
+ (Ada_Obj : in Storage.Integer_Address)
+ is
+ My_Text_Input : Text_Input;
+ for My_Text_Input'Address use Storage.To_Address (Ada_Obj);
+ pragma Import (Ada, My_Text_Input);
+ begin
+ Extra_Final (My_Text_Input);
+ end text_input_extra_final_hook;
+
+
+ procedure Extra_Final
+ (This : in out Text_Input) is
+ begin
+ Extra_Final (Input (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Text_Input) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_text_input (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ -- Last stop, everyone out!
+ procedure text_input_extra_init_hook
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.Strings.chars_ptr);
+ pragma Export (C, text_input_extra_init_hook, "text_input_extra_init_hook");
+
+ procedure text_input_extra_init_hook
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.Strings.chars_ptr)
+ is
+ My_Text_Input : Text_Input;
+ for My_Text_Input'Address use Storage.To_Address (Ada_Obj);
+ pragma Import (Ada, My_Text_Input);
+ begin
+ Extra_Init
+ (My_Text_Input,
+ Integer (X), Integer (Y),
+ Integer (W), Integer (H),
+ Interfaces.C.Strings.Value (C_Str));
+ end text_input_extra_init_hook;
+
+
+ procedure Extra_Init
+ (This : in out Text_Input;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Input (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Text_Input) is
+ begin
+ This.Draw_Ptr := fl_text_input_draw'Address;
+ This.Handle_Ptr := fl_text_input_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Text_Input is
+ begin
+ return This : Text_Input do
+ This.Void_Ptr := new_fl_text_input
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Text_Input is
+ begin
+ return This : Text_Input := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Draw
+ (This : in out Text_Input) is
+ begin
+ Input (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Text_Input;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Input (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Inputs.Text;
+
+
diff --git a/body/fltk-widgets-inputs.adb b/body/fltk-widgets-inputs.adb
new file mode 100644
index 0000000..0d3a3fe
--- /dev/null
+++ b/body/fltk-widgets-inputs.adb
@@ -0,0 +1,947 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets.Inputs is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_input
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_input, "new_fl_input");
+ pragma Inline (new_fl_input);
+
+ procedure free_fl_input
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_input, "free_fl_input");
+ pragma Inline (free_fl_input);
+
+
+
+
+ function fl_input_copy
+ (I : in Storage.Integer_Address;
+ C : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_copy, "fl_input_copy");
+ pragma Inline (fl_input_copy);
+
+ function fl_input_cut
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_cut, "fl_input_cut");
+ pragma Inline (fl_input_cut);
+
+ function fl_input_cut2
+ (I : in Storage.Integer_Address;
+ B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_cut2, "fl_input_cut2");
+ pragma Inline (fl_input_cut2);
+
+ function fl_input_cut3
+ (I : in Storage.Integer_Address;
+ A, B : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_cut3, "fl_input_cut3");
+ pragma Inline (fl_input_cut3);
+
+ function fl_input_copy_cuts
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_copy_cuts, "fl_input_copy_cuts");
+ pragma Inline (fl_input_copy_cuts);
+
+ function fl_input_undo
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_undo, "fl_input_undo");
+ pragma Inline (fl_input_undo);
+
+
+
+
+ function fl_input_get_readonly
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_get_readonly, "fl_input_get_readonly");
+ pragma Inline (fl_input_get_readonly);
+
+ procedure fl_input_set_readonly
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_set_readonly, "fl_input_set_readonly");
+ pragma Inline (fl_input_set_readonly);
+
+ function fl_input_get_tab_nav
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_get_tab_nav, "fl_input_get_tab_nav");
+ pragma Inline (fl_input_get_tab_nav);
+
+ procedure fl_input_set_tab_nav
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_set_tab_nav, "fl_input_set_tab_nav");
+ pragma Inline (fl_input_set_tab_nav);
+
+ function fl_input_get_wrap
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_get_wrap, "fl_input_get_wrap");
+ pragma Inline (fl_input_get_wrap);
+
+ procedure fl_input_set_wrap
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_set_wrap, "fl_input_set_wrap");
+ pragma Inline (fl_input_set_wrap);
+
+
+
+
+ function fl_input_get_input_type
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_get_input_type, "fl_input_get_input_type");
+ pragma Inline (fl_input_get_input_type);
+
+ procedure fl_input_set_input_type
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_set_input_type, "fl_input_set_input_type");
+ pragma Inline (fl_input_set_input_type);
+
+ function fl_input_get_shortcut
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_get_shortcut, "fl_input_get_shortcut");
+ pragma Inline (fl_input_get_shortcut);
+
+ procedure fl_input_set_shortcut
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_set_shortcut, "fl_input_set_shortcut");
+ pragma Inline (fl_input_set_shortcut);
+
+ function fl_input_get_mark
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_get_mark, "fl_input_get_mark");
+ pragma Inline (fl_input_get_mark);
+
+ function fl_input_set_mark
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_set_mark, "fl_input_set_mark");
+ pragma Inline (fl_input_set_mark);
+
+ function fl_input_get_position
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_get_position, "fl_input_get_position");
+ pragma Inline (fl_input_get_position);
+
+ function fl_input_set_position
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_set_position, "fl_input_set_position");
+ pragma Inline (fl_input_set_position);
+
+ function fl_input_set_position2
+ (I : in Storage.Integer_Address;
+ P, M : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_set_position2, "fl_input_set_position2");
+ pragma Inline (fl_input_set_position2);
+
+
+
+
+ function fl_input_index
+ (I : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_input_index, "fl_input_index");
+ pragma Inline (fl_input_index);
+
+ function fl_input_insert
+ (I : in Storage.Integer_Address;
+ S : in Interfaces.C.char_array;
+ L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_insert, "fl_input_insert");
+ pragma Inline (fl_input_insert);
+
+ function fl_input_replace
+ (I : in Storage.Integer_Address;
+ B, E : in Interfaces.C.int;
+ S : in Interfaces.C.char_array;
+ L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_replace, "fl_input_replace");
+ pragma Inline (fl_input_replace);
+
+ function fl_input_set_value
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array;
+ L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_set_value, "fl_input_set_value");
+ pragma Inline (fl_input_set_value);
+
+
+
+
+ function fl_input_get_maximum_size
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_get_maximum_size, "fl_input_get_maximum_size");
+ pragma Inline (fl_input_get_maximum_size);
+
+ procedure fl_input_set_maximum_size
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_set_maximum_size, "fl_input_set_maximum_size");
+ pragma Inline (fl_input_set_maximum_size);
+
+ function fl_input_get_size
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_get_size, "fl_input_get_size");
+ pragma Inline (fl_input_get_size);
+
+
+
+
+ function fl_input_get_cursor_color
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_input_get_cursor_color, "fl_input_get_cursor_color");
+ pragma Inline (fl_input_get_cursor_color);
+
+ procedure fl_input_set_cursor_color
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned);
+ pragma Import (C, fl_input_set_cursor_color, "fl_input_set_cursor_color");
+ pragma Inline (fl_input_set_cursor_color);
+
+ function fl_input_get_textcolor
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_input_get_textcolor, "fl_input_get_textcolor");
+ pragma Inline (fl_input_get_textcolor);
+
+ procedure fl_input_set_textcolor
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned);
+ pragma Import (C, fl_input_set_textcolor, "fl_input_set_textcolor");
+ pragma Inline (fl_input_set_textcolor);
+
+ function fl_input_get_textfont
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_get_textfont, "fl_input_get_textfont");
+ pragma Inline (fl_input_get_textfont);
+
+ procedure fl_input_set_textfont
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_set_textfont, "fl_input_set_textfont");
+ pragma Inline (fl_input_set_textfont);
+
+ function fl_input_get_textsize
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_get_textsize, "fl_input_get_textsize");
+ pragma Inline (fl_input_get_textsize);
+
+ procedure fl_input_set_textsize
+ (I : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_input_set_textsize, "fl_input_set_textsize");
+ pragma Inline (fl_input_set_textsize);
+
+
+
+
+ procedure fl_input_set_size
+ (I : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int);
+ pragma Import (C, fl_input_set_size, "fl_input_set_size");
+ pragma Inline (fl_input_set_size);
+
+ procedure fl_input_resize
+ (I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_input_resize, "fl_input_resize");
+ pragma Inline (fl_input_resize);
+
+
+
+
+ procedure fl_input_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_input_draw, "fl_input_draw");
+ pragma Inline (fl_input_draw);
+
+ function fl_input_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_input_handle, "fl_input_handle");
+ pragma Inline (fl_input_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Input) is
+ begin
+ Extra_Final (Widget (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Input) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_input (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Input;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Widget (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Input) is
+ begin
+ This.Draw_Ptr := fl_input_draw'Address;
+ This.Handle_Ptr := fl_input_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Input is
+ begin
+ return This : Input := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Copy
+ (This : in out Input;
+ Destination : in Clipboard_Kind := Cut_Paste_Board)
+ is
+ Result : Interfaces.C.int := fl_input_copy
+ (This.Void_Ptr, Clipboard_Kind'Pos (Destination));
+ begin
+ pragma Assert (Result in 0 .. 1);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Copy;
+
+
+ function Copy
+ (This : in out Input;
+ Destination : in Clipboard_Kind := Cut_Paste_Board)
+ return Boolean
+ is
+ Result : Interfaces.C.int := fl_input_copy
+ (This.Void_Ptr, Clipboard_Kind'Pos (Destination));
+ begin
+ pragma Assert (Result in 0 .. 1);
+ return Boolean'Val (Result);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Copy;
+
+
+ procedure Cut
+ (This : in out Input)
+ is
+ Result : Interfaces.C.int := fl_input_cut (This.Void_Ptr);
+ begin
+ null;
+ end Cut;
+
+
+ function Cut
+ (This : in out Input)
+ return Boolean is
+ begin
+ return fl_input_cut (This.Void_Ptr) /= 0;
+ end Cut;
+
+
+ procedure Cut
+ (This : in out Input;
+ Num_Bytes : in Integer)
+ is
+ Result : Interfaces.C.int := fl_input_cut2
+ (This.Void_Ptr,
+ Interfaces.C.int (Num_Bytes));
+ begin
+ null;
+ end Cut;
+
+
+ function Cut
+ (This : in out Input;
+ Num_Bytes : in Integer)
+ return Boolean is
+ begin
+ return fl_input_cut2
+ (This.Void_Ptr,
+ Interfaces.C.int (Num_Bytes)) /= 0;
+ end Cut;
+
+
+ procedure Cut
+ (This : in out Input;
+ Start, Finish : in Integer)
+ is
+ Result : Interfaces.C.int := fl_input_cut3
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish));
+ begin
+ null;
+ end Cut;
+
+
+ function Cut
+ (This : in out Input;
+ Start, Finish : in Integer)
+ return Boolean is
+ begin
+ return fl_input_cut3
+ (This.Void_Ptr,
+ Interfaces.C.int (Start),
+ Interfaces.C.int (Finish)) /= 0;
+ end Cut;
+
+
+ procedure Copy_Cuts
+ (This : in out Input)
+ is
+ Result : Interfaces.C.int := fl_input_copy_cuts (This.Void_Ptr);
+ begin
+ null;
+ end Copy_Cuts;
+
+
+ function Copy_Cuts
+ (This : in out Input)
+ return Boolean
+ is
+ Result : Interfaces.C.int := fl_input_copy_cuts (This.Void_Ptr);
+ begin
+ return Result /= 0;
+ end Copy_Cuts;
+
+
+ procedure Undo
+ (This : in out Input)
+ is
+ Result : Interfaces.C.int := fl_input_undo (This.Void_Ptr);
+ begin
+ null;
+ end Undo;
+
+
+ function Undo
+ (This : in out Input)
+ return Boolean is
+ begin
+ return fl_input_undo (This.Void_Ptr) /= 0;
+ end Undo;
+
+
+
+
+ function Is_Readonly
+ (This : in Input)
+ return Boolean is
+ begin
+ return fl_input_get_readonly (This.Void_Ptr) /= 0;
+ end Is_Readonly;
+
+
+ procedure Set_Readonly
+ (This : in out Input;
+ To : in Boolean) is
+ begin
+ fl_input_set_readonly (This.Void_Ptr, Boolean'Pos (To));
+ end Set_Readonly;
+
+
+ function Is_Tab_Nav
+ (This : in Input)
+ return Boolean is
+ begin
+ return fl_input_get_tab_nav (This.Void_Ptr) /= 0;
+ end Is_Tab_Nav;
+
+
+ procedure Set_Tab_Nav
+ (This : in out Input;
+ To : in Boolean) is
+ begin
+ fl_input_set_tab_nav (This.Void_Ptr, Boolean'Pos (To));
+ end Set_Tab_Nav;
+
+
+ function Is_Wrap
+ (This : in Input)
+ return Boolean is
+ begin
+ return fl_input_get_wrap (This.Void_Ptr) /= 0;
+ end Is_Wrap;
+
+
+ procedure Set_Wrap
+ (This : in out Input;
+ To : in Boolean) is
+ begin
+ fl_input_set_wrap (This.Void_Ptr, Boolean'Pos (To));
+ end Set_Wrap;
+
+
+
+
+ function Get_Kind
+ (This : in Input)
+ return Input_Kind
+ is
+ C_Val : Interfaces.C.int := fl_input_get_input_type (This.Void_Ptr);
+ begin
+ for V in Input_Kind loop
+ if Input_Kind_Values (V) = C_Val then
+ return V;
+ end if;
+ end loop;
+ return Normal_Field;
+ end Get_Kind;
+
+
+ function Get_Shortcut_Key
+ (This : in Input)
+ return Key_Combo is
+ begin
+ return To_Ada (fl_input_get_shortcut (This.Void_Ptr));
+ end Get_Shortcut_Key;
+
+
+ procedure Set_Shortcut_Key
+ (This : in out Input;
+ To : in Key_Combo) is
+ begin
+ fl_input_set_shortcut (This.Void_Ptr, To_C (To));
+ end Set_Shortcut_Key;
+
+
+ function Get_Mark
+ (This : in Input)
+ return Natural is
+ begin
+ return Natural (fl_input_get_mark (This.Void_Ptr));
+ end Get_Mark;
+
+
+ procedure Set_Mark
+ (This : in out Input;
+ To : in Natural)
+ is
+ Result : Interfaces.C.int := fl_input_set_mark
+ (This.Void_Ptr,
+ Interfaces.C.int (To));
+ begin
+ null;
+ end Set_Mark;
+
+
+ function Set_Mark
+ (This : in out Input;
+ To : in Natural)
+ return Boolean is
+ begin
+ return fl_input_set_mark
+ (This.Void_Ptr,
+ Interfaces.C.int (To)) /= 0;
+ end Set_Mark;
+
+
+ function Get_Position
+ (This : in Input)
+ return Natural is
+ begin
+ return Natural (fl_input_get_position (This.Void_Ptr));
+ end Get_Position;
+
+
+ procedure Set_Position
+ (This : in out Input;
+ To : in Natural)
+ is
+ Result : Interfaces.C.int := fl_input_set_position
+ (This.Void_Ptr,
+ Interfaces.C.int (To));
+ begin
+ null;
+ end Set_Position;
+
+
+ function Set_Position
+ (This : in out Input;
+ To : in Natural)
+ return Boolean is
+ begin
+ return fl_input_set_position
+ (This.Void_Ptr,
+ Interfaces.C.int (To)) /= 0;
+ end Set_Position;
+
+
+ procedure Set_Position_Mark
+ (This : in out Input;
+ Place : in Natural;
+ Mark : in Natural)
+ is
+ Result : Interfaces.C.int := fl_input_set_position2
+ (This.Void_Ptr,
+ Interfaces.C.int (Place),
+ Interfaces.C.int (Mark));
+ begin
+ null;
+ end Set_Position_Mark;
+
+
+ function Set_Position_Mark
+ (This : in out Input;
+ Place : in Natural;
+ Mark : in Natural)
+ return Boolean is
+ begin
+ return fl_input_set_position2
+ (This.Void_Ptr,
+ Interfaces.C.int (Place),
+ Interfaces.C.int (Mark)) /= 0;
+ end Set_Position_Mark;
+
+
+
+
+ function Index
+ (This : in Input;
+ Place : in Integer)
+ return Character is
+ begin
+ return Character'Val (fl_input_index (This.Void_Ptr, Interfaces.C.int (Place)));
+ end Index;
+
+
+ procedure Insert
+ (This : in out Input;
+ Str : in String)
+ is
+ Result : Interfaces.C.int := fl_input_insert
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Str, False),
+ Str'Length);
+ begin
+ null;
+ end Insert;
+
+
+ function Insert
+ (This : in out Input;
+ Str : in String)
+ return Boolean is
+ begin
+ return fl_input_insert
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Str, False),
+ Str'Length) /= 0;
+ end Insert;
+
+
+ procedure Replace
+ (This : in out Input;
+ From, To : in Natural;
+ New_Text : in String)
+ is
+ Result : Interfaces.C.int := fl_input_replace
+ (This.Void_Ptr,
+ Interfaces.C.int (From),
+ Interfaces.C.int (To),
+ Interfaces.C.To_C (New_Text),
+ New_Text'Length);
+ begin
+ null;
+ end Replace;
+
+
+ function Replace
+ (This : in out Input;
+ From, To : in Natural;
+ New_Text : in String)
+ return Boolean is
+ begin
+ return fl_input_replace
+ (This.Void_Ptr,
+ Interfaces.C.int (From),
+ Interfaces.C.int (To),
+ Interfaces.C.To_C (New_Text, False),
+ New_Text'Length) /= 0;
+ end Replace;
+
+
+ function Get_Value
+ (This : in Input)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ -- pointer to internal buffer only, so no Free required
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Get_Value;
+
+
+ procedure Set_Value
+ (This : in out Input;
+ To : in String)
+ is
+ Result : Interfaces.C.int := fl_input_set_value
+ (This.Void_Ptr, Interfaces.C.To_C (To), To'Length);
+ begin
+ null;
+ end Set_Value;
+
+
+ function Set_Value
+ (This : in out Input;
+ To : in String)
+ return Boolean is
+ begin
+ return fl_input_set_value
+ (This.Void_Ptr,
+ Interfaces.C.To_C (To, False),
+ To'Length) /= 0;
+ end Set_Value;
+
+
+
+
+ function Get_Maximum_Size
+ (This : in Input)
+ return Natural is
+ begin
+ return Natural (fl_input_get_maximum_size (This.Void_Ptr));
+ end Get_Maximum_Size;
+
+
+ procedure Set_Maximum_Size
+ (This : in out Input;
+ To : in Natural) is
+ begin
+ fl_input_set_maximum_size (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Maximum_Size;
+
+
+ function Size
+ (This : in Input)
+ return Natural is
+ begin
+ return Natural (fl_input_get_size (This.Void_Ptr));
+ end Size;
+
+
+
+
+ function Get_Cursor_Color
+ (This : in Input)
+ return Color is
+ begin
+ return Color (fl_input_get_cursor_color (This.Void_Ptr));
+ end Get_Cursor_Color;
+
+
+ procedure Set_Cursor_Color
+ (This : in out Input;
+ To : in Color) is
+ begin
+ fl_input_set_cursor_color (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Cursor_Color;
+
+
+ function Get_Text_Color
+ (This : in Input)
+ return Color is
+ begin
+ return Color (fl_input_get_textcolor (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Input;
+ To : in Color) is
+ begin
+ fl_input_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Input)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_input_get_textfont (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Input;
+ To : in Font_Kind) is
+ begin
+ fl_input_set_textfont (This.Void_Ptr, Font_Kind'Pos (To));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Input)
+ return Font_Size is
+ begin
+ return Font_Size (fl_input_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Input;
+ To : in Font_Size) is
+ begin
+ fl_input_set_textsize (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Text_Size;
+
+
+
+
+ procedure Resize
+ (This : in out Input;
+ W, H : in Integer) is
+ begin
+ fl_input_set_size (This.Void_Ptr, Interfaces.C.int (W), Interfaces.C.int (H));
+ end Resize;
+
+
+ procedure Resize
+ (This : in out Input;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_input_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+
+
+ package body Extra is
+
+ procedure Set_Kind
+ (This : in out Input;
+ To : in Input_Kind) is
+ begin
+ fl_input_set_input_type (This.Void_Ptr, Input_Kind_Values (To));
+ end Set_Kind;
+
+ pragma Inline (Set_Kind);
+
+ end Extra;
+
+
+end FLTK.Widgets.Inputs;
+
+
diff --git a/body/fltk-widgets-menus-choices.adb b/body/fltk-widgets-menus-choices.adb
new file mode 100644
index 0000000..e4b52ad
--- /dev/null
+++ b/body/fltk-widgets-menus-choices.adb
@@ -0,0 +1,239 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C,
+ System;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Menus.Choices is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_choice
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_choice, "new_fl_choice");
+ pragma Inline (new_fl_choice);
+
+ procedure free_fl_choice
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_choice, "free_fl_choice");
+ pragma Inline (free_fl_choice);
+
+
+
+
+ function fl_choice_value
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_choice_value, "fl_choice_value");
+ pragma Inline (fl_choice_value);
+
+ function fl_choice_set_value
+ (M, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_choice_set_value, "fl_choice_set_value");
+ pragma Inline (fl_choice_set_value);
+
+ function fl_choice_set_value2
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_choice_set_value2, "fl_choice_set_value2");
+ pragma Inline (fl_choice_set_value2);
+
+
+
+
+ procedure fl_choice_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_choice_draw, "fl_choice_draw");
+ pragma Inline (fl_choice_draw);
+
+ function fl_choice_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_choice_handle, "fl_choice_handle");
+ pragma Inline (fl_choice_handle);
+
+
+
+
+ function fl_menu_get_item
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_get_item, "fl_menu_get_item");
+ pragma Inline (fl_menu_get_item);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Choice) is
+ begin
+ Extra_Final (Menu (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Choice) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_choice (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Choice;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Menu (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Choice) is
+ begin
+ This.Draw_Ptr := fl_choice_draw'Address;
+ This.Handle_Ptr := fl_choice_handle'Address;
+ This.Get_Item_Ptr := fl_menu_get_item'Address;
+ This.Value_Ptr := fl_choice_value'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Choice is
+ begin
+ return This : Choice do
+ This.Void_Ptr := new_fl_choice
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Choice is
+ begin
+ return This : Choice := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Chosen_Index
+ (This : in Choice)
+ return Extended_Index is
+ begin
+ return Menu (This).Chosen_Index;
+ end Chosen_Index;
+
+
+ procedure Set_Chosen
+ (This : in out Choice;
+ Item : in FLTK.Menu_Items.Menu_Item)
+ is
+ Ignore_Ret : Interfaces.C.int;
+ begin
+ Ignore_Ret := fl_choice_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+ end Set_Chosen;
+
+
+ function Set_Chosen
+ (This : in out Choice;
+ Item : in FLTK.Menu_Items.Menu_Item)
+ return Boolean is
+ begin
+ return fl_choice_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr) /= 0;
+ end Set_Chosen;
+
+
+ procedure Set_Chosen
+ (This : in out Choice;
+ Place : in Index)
+ is
+ Ignore_Ret : Interfaces.C.int;
+ begin
+ Ignore_Ret := fl_choice_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+ end Set_Chosen;
+
+
+ function Set_Chosen
+ (This : in out Choice;
+ Place : in Index)
+ return Boolean is
+ begin
+ return fl_choice_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1) /= 0;
+ end Set_Chosen;
+
+
+
+
+ procedure Draw
+ (This : in out Choice) is
+ begin
+ Menu (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Choice;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Menu (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Menus.Choices;
+
+
diff --git a/body/fltk-widgets-menus-menu_bars-systemwide.adb b/body/fltk-widgets-menus-menu_bars-systemwide.adb
new file mode 100644
index 0000000..bccdc2e
--- /dev/null
+++ b/body/fltk-widgets-menus-menu_bars-systemwide.adb
@@ -0,0 +1,619 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Ada.Unchecked_Deallocation,
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is
+
+
+ package Chk renames Ada.Assertions;
+
+ procedure Free_Item is new Ada.Unchecked_Deallocation
+ (Object => FLTK.Menu_Items.Menu_Item, Name => Item_Access);
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_sys_menu_bar
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_sys_menu_bar, "new_fl_sys_menu_bar");
+ pragma Inline (new_fl_sys_menu_bar);
+
+ procedure free_fl_sys_menu_bar
+ (M : in Storage.Integer_Address);
+ pragma Import (C, free_fl_sys_menu_bar, "free_fl_sys_menu_bar");
+ pragma Inline (free_fl_sys_menu_bar);
+
+
+
+
+ function fl_sys_menu_bar_add
+ (M : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_add, "fl_sys_menu_bar_add");
+ pragma Inline (fl_sys_menu_bar_add);
+
+ function fl_sys_menu_bar_add2
+ (M : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array;
+ S : in Interfaces.C.int;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_add2, "fl_sys_menu_bar_add2");
+ pragma Inline (fl_sys_menu_bar_add2);
+
+ function fl_sys_menu_bar_add3
+ (M : in Storage.Integer_Address;
+ T, S : in Interfaces.C.char_array;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_add3, "fl_sys_menu_bar_add3");
+ pragma Inline (fl_sys_menu_bar_add3);
+
+ function fl_sys_menu_bar_insert
+ (M : in Storage.Integer_Address;
+ P : in Interfaces.C.int;
+ T : in Interfaces.C.char_array;
+ S : in Interfaces.C.int;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_insert, "fl_sys_menu_bar_insert");
+ pragma Inline (fl_sys_menu_bar_insert);
+
+ function fl_sys_menu_bar_insert2
+ (M : in Storage.Integer_Address;
+ P : in Interfaces.C.int;
+ T, S : in Interfaces.C.char_array;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_insert2, "fl_sys_menu_bar_insert2");
+ pragma Inline (fl_sys_menu_bar_insert2);
+
+ procedure fl_sys_menu_bar_set_menu
+ (M, D : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_set_menu, "fl_sys_menu_bar_set_menu");
+ pragma Inline (fl_sys_menu_bar_set_menu);
+
+ procedure fl_sys_menu_bar_remove
+ (M : in Storage.Integer_Address;
+ P : in Interfaces.C.int);
+ pragma Import (C, fl_sys_menu_bar_remove, "fl_sys_menu_bar_remove");
+ pragma Inline (fl_sys_menu_bar_remove);
+
+ procedure fl_sys_menu_bar_clear
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_clear, "fl_sys_menu_bar_clear");
+ pragma Inline (fl_sys_menu_bar_clear);
+
+ function fl_sys_menu_bar_clear_submenu
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_clear_submenu, "fl_sys_menu_bar_clear_submenu");
+ pragma Inline (fl_sys_menu_bar_clear_submenu);
+
+
+
+
+ function fl_sys_menu_bar_get_item
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_sys_menu_bar_get_item, "fl_sys_menu_bar_get_item");
+ pragma Inline (fl_sys_menu_bar_get_item);
+
+
+
+
+ procedure fl_sys_menu_bar_setonly
+ (M, I : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_setonly, "fl_sys_menu_bar_setonly");
+ pragma Inline (fl_sys_menu_bar_setonly);
+
+ procedure fl_sys_menu_bar_replace
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_sys_menu_bar_replace, "fl_sys_menu_bar_replace");
+ pragma Inline (fl_sys_menu_bar_replace);
+
+ procedure fl_sys_menu_bar_shortcut
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_sys_menu_bar_shortcut, "fl_sys_menu_bar_shortcut");
+ pragma Inline (fl_sys_menu_bar_shortcut);
+
+ function fl_sys_menu_bar_get_mode
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_get_mode, "fl_sys_menu_bar_get_mode");
+ pragma Inline (fl_sys_menu_bar_get_mode);
+
+ procedure fl_sys_menu_bar_set_mode
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_sys_menu_bar_set_mode, "fl_sys_menu_bar_set_mode");
+ pragma Inline (fl_sys_menu_bar_set_mode);
+
+
+
+
+ procedure fl_sys_menu_bar_global
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_global, "fl_sys_menu_bar_global");
+ pragma Inline (fl_sys_menu_bar_global);
+
+ procedure fl_sys_menu_bar_update
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_update, "fl_sys_menu_bar_update");
+ pragma Inline (fl_sys_menu_bar_update);
+
+
+
+
+ procedure fl_sys_menu_bar_draw
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_draw, "fl_sys_menu_bar_draw");
+ pragma Inline (fl_sys_menu_bar_draw);
+
+ function fl_sys_menu_bar_handle
+ (M : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_handle, "fl_sys_menu_bar_handle");
+ pragma Inline (fl_sys_menu_bar_handle);
+
+
+
+
+ function fl_menu_value
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_value, "fl_menu_value");
+ pragma Inline (fl_menu_value);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out System_Menu_Bar) is
+ begin
+ Extra_Final (Menu_Bar (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out System_Menu_Bar) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_sys_menu_bar (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out System_Menu_Bar;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Menu_Bar (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out System_Menu_Bar) is
+ begin
+ This.Draw_Ptr := fl_sys_menu_bar_draw'Address;
+ This.Handle_Ptr := fl_sys_menu_bar_handle'Address;
+ This.Get_Item_Ptr := fl_sys_menu_bar_get_item'Address;
+ This.Value_Ptr := fl_menu_value'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return System_Menu_Bar is
+ begin
+ return This : System_Menu_Bar do
+ This.Void_Ptr := new_fl_sys_menu_bar
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return System_Menu_Bar is
+ begin
+ return This : System_Menu_Bar := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Add
+ (This : in out System_Menu_Bar;
+ Text : in String)
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add
+ (This.Void_Ptr, Interfaces.C.To_C (Text));
+ begin
+ This.Adjust_Item_Store;
+ end Add;
+
+
+ function Add
+ (This : in out System_Menu_Bar;
+ Text : in String)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add
+ (This.Void_Ptr, Interfaces.C.To_C (Text));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Add;
+
+
+ procedure Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add2
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Add;
+
+
+ function Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add2
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Add;
+
+
+ procedure Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add3
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Add;
+
+
+ function Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add3
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Add;
+
+
+ procedure Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Insert;
+
+
+ function Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Insert;
+
+
+ procedure Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert2
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Insert;
+
+
+ function Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert2
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Insert;
+
+
+ procedure Use_Same_Items
+ (This : in out System_Menu_Bar;
+ Donor : in Menu'Class) is
+ begin
+ -- Donor menu() pointer will be obtained in C++
+ fl_sys_menu_bar_set_menu (This.Void_Ptr, Donor.Void_Ptr);
+ This.Adjust_Item_Store;
+ end Use_Same_Items;
+
+
+ procedure Remove
+ (This : in out System_Menu_Bar;
+ Place : in Index) is
+ begin
+ fl_sys_menu_bar_remove (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+ This.Adjust_Item_Store;
+ end Remove;
+
+
+ procedure Clear
+ (This : in out System_Menu_Bar) is
+ begin
+ for Item of This.My_Items loop
+ Free_Item (Item);
+ end loop;
+ This.My_Items.Clear;
+ fl_sys_menu_bar_clear (This.Void_Ptr);
+ end Clear;
+
+
+ procedure Clear_Submenu
+ (This : in out System_Menu_Bar;
+ Place : in Index)
+ is
+ Result : Interfaces.C.int := fl_sys_menu_bar_clear_submenu
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1);
+ begin
+ if Result = -1 then
+ raise No_Reference_Error;
+ else
+ pragma Assert (Result = 0);
+ This.Adjust_Item_Store;
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error with
+ "Call to Fl_Sys_Menu_Bar::clear_submenu returned unexpected int result of " &
+ Interfaces.C.int'Image (Result);
+ end Clear_Submenu;
+
+
+
+
+ function Item
+ (This : in System_Menu_Bar;
+ Place : in Index)
+ return FLTK.Menu_Items.Menu_Item_Reference is
+ begin
+ return Menu_Bar (This).Item (Place);
+ end Item;
+
+
+
+
+ procedure Set_Only
+ (This : in out System_Menu_Bar;
+ Item : in out FLTK.Menu_Items.Menu_Item) is
+ begin
+ fl_sys_menu_bar_setonly (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+ end Set_Only;
+
+
+ procedure Set_Label
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String) is
+ begin
+ fl_sys_menu_bar_replace
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text));
+ end Set_Label;
+
+
+ procedure Set_Shortcut
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Press : in Key_Combo) is
+ begin
+ fl_sys_menu_bar_shortcut
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ To_C (Press));
+ end Set_Shortcut;
+
+
+ function Get_Flags
+ (This : in System_Menu_Bar;
+ Place : in Index)
+ return Menu_Flag is
+ begin
+ return Menu_Flag (fl_sys_menu_bar_get_mode (This.Void_Ptr, Interfaces.C.int (Place) - 1));
+ end Get_Flags;
+
+
+ procedure Set_Flags
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Flags : in Menu_Flag) is
+ begin
+ fl_sys_menu_bar_set_mode
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.int (Flags));
+ end Set_Flags;
+
+
+
+
+ procedure Make_Global
+ (This : in out System_Menu_Bar) is
+ begin
+ fl_sys_menu_bar_global (This.Void_Ptr);
+ end Make_Global;
+
+
+ procedure Update
+ (This : in out System_Menu_Bar) is
+ begin
+ fl_sys_menu_bar_update (This.Void_Ptr);
+ end Update;
+
+
+
+
+ procedure Draw
+ (This : in out System_Menu_Bar) is
+ begin
+ Menu_Bar (This).Draw;
+ end Draw;
+
+
+end FLTK.Widgets.Menus.Menu_Bars.Systemwide;
+
+
diff --git a/body/fltk-widgets-menus-menu_bars.adb b/body/fltk-widgets-menus-menu_bars.adb
new file mode 100644
index 0000000..f1dba40
--- /dev/null
+++ b/body/fltk-widgets-menus-menu_bars.adb
@@ -0,0 +1,170 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Menus.Menu_Bars is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_menu_bar
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_menu_bar, "new_fl_menu_bar");
+ pragma Inline (new_fl_menu_bar);
+
+ procedure free_fl_menu_bar
+ (M : in Storage.Integer_Address);
+ pragma Import (C, free_fl_menu_bar, "free_fl_menu_bar");
+ pragma Inline (free_fl_menu_bar);
+
+
+
+
+ procedure fl_menu_bar_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_bar_draw, "fl_menu_bar_draw");
+ pragma Inline (fl_menu_bar_draw);
+
+ function fl_menu_bar_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_bar_handle, "fl_menu_bar_handle");
+ pragma Inline (fl_menu_bar_handle);
+
+
+
+
+ function fl_menu_get_item
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_get_item, "fl_menu_get_item");
+ pragma Inline (fl_menu_get_item);
+
+ function fl_menu_value
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_value, "fl_menu_value");
+ pragma Inline (fl_menu_value);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Menu_Bar) is
+ begin
+ Extra_Final (Menu (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Menu_Bar) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_menu_bar (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Menu_Bar;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Menu (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Menu_Bar) is
+ begin
+ This.Draw_Ptr := fl_menu_bar_draw'Address;
+ This.Handle_Ptr := fl_menu_bar_handle'Address;
+ This.Get_Item_Ptr := fl_menu_get_item'Address;
+ This.Value_Ptr := fl_menu_value'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Menu_Bar is
+ begin
+ return This : Menu_Bar := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Draw
+ (This : in out Menu_Bar) is
+ begin
+ Menu (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Menu_Bar;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Menu (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Menus.Menu_Bars;
+
+
diff --git a/body/fltk-widgets-menus-menu_buttons.adb b/body/fltk-widgets-menus-menu_buttons.adb
new file mode 100644
index 0000000..b526e49
--- /dev/null
+++ b/body/fltk-widgets-menus-menu_buttons.adb
@@ -0,0 +1,260 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Menus.Menu_Buttons is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_menu_button
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_menu_button, "new_fl_menu_button");
+ pragma Inline (new_fl_menu_button);
+
+ procedure free_fl_menu_button
+ (M : in Storage.Integer_Address);
+ pragma Import (C, free_fl_menu_button, "free_fl_menu_button");
+ pragma Inline (free_fl_menu_button);
+
+
+
+
+ function fl_menu_button_popup
+ (M : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_button_popup, "fl_menu_button_popup");
+ pragma Inline (fl_menu_button_popup);
+
+ function fl_menu_find_index2
+ (M, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_find_index2, "fl_menu_find_index2");
+ pragma Inline (fl_menu_find_index2);
+
+
+
+
+ procedure fl_menu_button_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_button_draw, "fl_menu_button_draw");
+ pragma Inline (fl_menu_button_draw);
+
+ function fl_menu_button_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_button_handle, "fl_menu_button_handle");
+ pragma Inline (fl_menu_button_handle);
+
+
+
+
+ function fl_menu_get_item
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_get_item, "fl_menu_get_item");
+ pragma Inline (fl_menu_get_item);
+
+ function fl_menu_value
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_value, "fl_menu_value");
+ pragma Inline (fl_menu_value);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ -- More magic
+ procedure menu_button_extra_final_hook
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Export (C, menu_button_extra_final_hook, "menu_button_extra_final_hook");
+
+ procedure menu_button_extra_final_hook
+ (Ada_Obj : in Storage.Integer_Address)
+ is
+ My_Menu_Button : Menu_Button;
+ for My_Menu_Button'Address use Storage.To_Address (Ada_Obj);
+ pragma Import (Ada, My_Menu_Button);
+ begin
+ Extra_Final (My_Menu_Button);
+ end menu_button_extra_final_hook;
+
+
+ procedure Extra_Final
+ (This : in out Menu_Button) is
+ begin
+ Extra_Final (Menu (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Menu_Button) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_menu_button (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ -- Long distance telephone call receival
+ procedure menu_button_extra_init_hook
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.Strings.chars_ptr);
+ pragma Export (C, menu_button_extra_init_hook, "menu_button_extra_init_hook");
+
+ procedure menu_button_extra_init_hook
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.Strings.chars_ptr)
+ is
+ My_Menu_Button : Menu_Button;
+ for My_Menu_Button'Address use Storage.To_Address (Ada_Obj);
+ pragma Import (Ada, My_Menu_Button);
+ begin
+ Extra_Init
+ (My_Menu_Button,
+ Integer (X), Integer (Y),
+ Integer (W), Integer (H),
+ Interfaces.C.Strings.Value (C_Str));
+ end menu_button_extra_init_hook;
+
+
+ procedure Extra_Init
+ (This : in out Menu_Button;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Menu (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Menu_Button) is
+ begin
+ This.Draw_Ptr := fl_menu_button_draw'Address;
+ This.Handle_Ptr := fl_menu_button_handle'Address;
+ This.Get_Item_Ptr := fl_menu_get_item'Address;
+ This.Value_Ptr := fl_menu_value'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ 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));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Menu_Button is
+ begin
+ return This : Menu_Button := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Popup_Kind
+ (This : in Menu_Button)
+ return Popup_Buttons
+ is
+ Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr);
+ begin
+ return Popup_Buttons'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Menu_Button::type returned unexpected Popup_Buttons value of " &
+ Interfaces.C.unsigned_char'Image (Result);
+ end Get_Popup_Kind;
+
+
+ procedure Set_Popup_Kind
+ (This : in out Menu_Button;
+ Kind : in Popup_Buttons) is
+ begin
+ fl_widget_set_type (This.Void_Ptr, Popup_Buttons'Pos (Kind));
+ end Set_Popup_Kind;
+
+
+ function Popup
+ (This : in out Menu_Button)
+ return Extended_Index
+ is
+ use type Interfaces.C.int;
+ Ptr : Storage.Integer_Address := fl_menu_button_popup (This.Void_Ptr);
+ begin
+ return Extended_Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1);
+ end Popup;
+
+
+
+
+ procedure Draw
+ (This : in out Menu_Button) is
+ begin
+ Menu (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Menu_Button;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Menu (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Menus.Menu_Buttons;
+
+
diff --git a/body/fltk-widgets-menus.adb b/body/fltk-widgets-menus.adb
new file mode 100644
index 0000000..034cd4c
--- /dev/null
+++ b/body/fltk-widgets-menus.adb
@@ -0,0 +1,1424 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Ada.Unchecked_Deallocation,
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets.Menus is
+
+
+ package Chk renames Ada.Assertions;
+
+ procedure Free_Item is new Ada.Unchecked_Deallocation
+ (Object => FLTK.Menu_Items.Menu_Item, Name => Item_Access);
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function null_fl_menu_item
+ return Storage.Integer_Address;
+ pragma Import (C, null_fl_menu_item, "null_fl_menu_item");
+ pragma Inline (null_fl_menu_item);
+
+ procedure free_fl_menu_item
+ (MI : in Storage.Integer_Address);
+ pragma Import (C, free_fl_menu_item, "free_fl_menu_item");
+ pragma Inline (free_fl_menu_item);
+
+ function new_fl_menu
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_menu, "new_fl_menu");
+ pragma Inline (new_fl_menu);
+
+ procedure free_fl_menu
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_menu, "free_fl_menu");
+ pragma Inline (free_fl_menu);
+
+
+
+
+ function fl_menu_add
+ (M : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_add, "fl_menu_add");
+ pragma Inline (fl_menu_add);
+
+ function fl_menu_add2
+ (M : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array;
+ S : in Interfaces.C.int;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_add2, "fl_menu_add2");
+ pragma Inline (fl_menu_add2);
+
+ function fl_menu_add3
+ (M : in Storage.Integer_Address;
+ T, S : in Interfaces.C.char_array;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_add3, "fl_menu_add3");
+ pragma Inline (fl_menu_add3);
+
+ function fl_menu_insert
+ (M : in Storage.Integer_Address;
+ P : in Interfaces.C.int;
+ T : in Interfaces.C.char_array;
+ S : in Interfaces.C.int;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_insert, "fl_menu_insert");
+ pragma Inline (fl_menu_insert);
+
+ function fl_menu_insert2
+ (M : in Storage.Integer_Address;
+ P : in Interfaces.C.int;
+ T, S : in Interfaces.C.char_array;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_insert2, "fl_menu_insert2");
+ pragma Inline (fl_menu_insert2);
+
+ procedure fl_menu_copy
+ (M, I : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_copy, "fl_menu_copy");
+ pragma Inline (fl_menu_copy);
+
+ procedure fl_menu_set_menu
+ (M, D : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_set_menu, "fl_menu_set_menu");
+ pragma Inline (fl_menu_set_menu);
+
+ procedure fl_menu_remove
+ (M : in Storage.Integer_Address;
+ P : in Interfaces.C.int);
+ pragma Import (C, fl_menu_remove, "fl_menu_remove");
+ pragma Inline (fl_menu_remove);
+
+ procedure fl_menu_clear
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_clear, "fl_menu_clear");
+ pragma Inline (fl_menu_clear);
+
+ function fl_menu_clear_submenu
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_clear_submenu, "fl_menu_clear_submenu");
+ pragma Inline (fl_menu_clear_submenu);
+
+
+
+
+ function fl_menu_get_item
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_get_item, "fl_menu_get_item");
+ pragma Inline (fl_menu_get_item);
+
+ function fl_menu_find_index
+ (M : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_find_index, "fl_menu_find_index");
+ pragma Inline (fl_menu_find_index);
+
+ function fl_menu_find_index2
+ (M, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_find_index2, "fl_menu_find_index2");
+ pragma Inline (fl_menu_find_index2);
+
+ function fl_menu_find_index3
+ (M, C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_find_index3, "fl_menu_find_index3");
+ -- No inline
+
+ function fl_menu_item_pathname
+ (M : in Storage.Integer_Address;
+ B : out Interfaces.C.char_array;
+ L : in Interfaces.C.int;
+ I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_pathname, "fl_menu_item_pathname");
+ pragma Inline (fl_menu_item_pathname);
+
+ function fl_menu_size
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_size, "fl_menu_size");
+ pragma Inline (fl_menu_size);
+
+
+
+
+ function fl_menu_text
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_menu_text, "fl_menu_text");
+ pragma Inline (fl_menu_text);
+
+ function fl_menu_value
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_value, "fl_menu_value");
+ pragma Inline (fl_menu_value);
+
+ function fl_menu_set_value
+ (M, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_set_value, "fl_menu_set_value");
+ pragma Inline (fl_menu_set_value);
+
+ function fl_menu_set_value2
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_set_value2, "fl_menu_set_value2");
+ pragma Inline (fl_menu_set_value2);
+
+
+
+
+ procedure fl_menu_setonly
+ (M, I : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_setonly, "fl_menu_setonly");
+ pragma Inline (fl_menu_setonly);
+
+ function fl_menu_text2
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_menu_text2, "fl_menu_text2");
+ pragma Inline (fl_menu_text2);
+
+ procedure fl_menu_replace
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_menu_replace, "fl_menu_replace");
+ pragma Inline (fl_menu_replace);
+
+ procedure fl_menu_shortcut
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_menu_shortcut, "fl_menu_shortcut");
+ pragma Inline (fl_menu_shortcut);
+
+ function fl_menu_get_mode
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_get_mode, "fl_menu_get_mode");
+ pragma Inline (fl_menu_get_mode);
+
+ procedure fl_menu_set_mode
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_menu_set_mode, "fl_menu_set_mode");
+ pragma Inline (fl_menu_set_mode);
+
+
+
+
+ function fl_menu_get_textcolor
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_menu_get_textcolor, "fl_menu_get_textcolor");
+ pragma Inline (fl_menu_get_textcolor);
+
+ procedure fl_menu_set_textcolor
+ (M : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_menu_set_textcolor, "fl_menu_set_textcolor");
+ pragma Inline (fl_menu_set_textcolor);
+
+ function fl_menu_get_textfont
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_get_textfont, "fl_menu_get_textfont");
+ pragma Inline (fl_menu_get_textfont);
+
+ procedure fl_menu_set_textfont
+ (M : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_menu_set_textfont, "fl_menu_set_textfont");
+ pragma Inline (fl_menu_set_textfont);
+
+ function fl_menu_get_textsize
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_get_textsize, "fl_menu_get_textsize");
+ pragma Inline (fl_menu_get_textsize);
+
+ procedure fl_menu_set_textsize
+ (M : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_menu_set_textsize, "fl_menu_set_textsize");
+ pragma Inline (fl_menu_set_textsize);
+
+
+
+
+ function fl_menu_get_down_box
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_get_down_box, "fl_menu_get_down_box");
+ pragma Inline (fl_menu_get_down_box);
+
+ procedure fl_menu_set_down_box
+ (M : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_menu_set_down_box, "fl_menu_set_down_box");
+ pragma Inline (fl_menu_set_down_box);
+
+ procedure fl_menu_global
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_global, "fl_menu_global");
+ pragma Inline (fl_menu_global);
+
+ function fl_menu_measure
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ H : out Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_measure, "fl_menu_measure");
+ pragma Inline (fl_menu_measure);
+
+
+
+
+ function fl_menu_popup
+ (M : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int;
+ T : in Interfaces.C.Strings.chars_ptr;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_popup, "fl_menu_popup");
+ -- No inline
+
+ function fl_menu_pulldown
+ (M : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_pulldown, "fl_menu_pulldown");
+ -- No inline
+
+ function fl_menu_picked
+ (M, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_picked, "fl_menu_picked");
+ pragma Inline (fl_menu_picked);
+
+ function fl_menu_find_shortcut
+ (M, I : in Storage.Integer_Address;
+ A : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_find_shortcut, "fl_menu_find_shortcut");
+ pragma Inline (fl_menu_find_shortcut);
+
+ function fl_menu_test_shortcut
+ (M : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_test_shortcut, "fl_menu_test_shortcut");
+ pragma Inline (fl_menu_test_shortcut);
+
+
+
+
+ procedure fl_menu_size2
+ (M : in Storage.Integer_Address;
+ W, H : in Interfaces.C.int);
+ pragma Import (C, fl_menu_size2, "fl_menu_size2");
+ pragma Inline (fl_menu_size2);
+
+
+
+
+ procedure fl_menu_draw_item
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ X, Y, W, H : in Interfaces.C.int;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_menu_draw_item, "fl_menu_draw_item");
+ pragma Inline (fl_menu_draw_item);
+
+ procedure fl_menu_draw
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_menu_draw, "fl_menu_draw");
+ pragma Inline (fl_menu_draw);
+
+ function fl_menu_handle
+ (M : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_handle, "fl_menu_handle");
+ pragma Inline (fl_menu_handle);
+
+
+
+
+ ------------------------
+ -- Internal Utility --
+ ------------------------
+
+ procedure Adjust_Item_Store
+ (This : in out Menu)
+ is
+ Target : Natural := This.Number_Of_Items;
+ begin
+ while Natural (This.My_Items.Length) > Target loop
+ Free_Item (This.My_Items.Reference (This.My_Items.Last_Index));
+ This.My_Items.Delete_Last;
+ end loop;
+ while Natural (This.My_Items.Length) < Target loop
+ This.My_Items.Append (new FLTK.Menu_Items.Menu_Item);
+ Wrapper (This.My_Items.Last_Element.all).Needs_Dealloc := False;
+ end loop;
+ end Adjust_Item_Store;
+
+
+ -- Needed for setting a whole array of Menu_Items at once
+ Null_Item : Storage.Integer_Address := null_fl_menu_item;
+
+
+
+
+ ----------------------
+ -- Callback Hooks --
+ ----------------------
+
+ procedure Item_Hook
+ (C_Obj, User_Data : in Storage.Integer_Address);
+ pragma Export (C, Item_Hook, "menu_item_callback_hook");
+
+ -- Used for Add and Insert, the userdata parameter is the actual callback we want
+ procedure Item_Hook
+ (C_Obj, User_Data : in Storage.Integer_Address)
+ is
+ Ada_Ptr : Storage.Integer_Address := fl_widget_get_user_data (C_Obj);
+ Ada_Widget : access Widget'Class;
+ Action : Widget_Callback := Callback_Convert.To_Access (User_Data);
+ begin
+ pragma Assert (Ada_Ptr /= Null_Pointer);
+ Ada_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Ada_Ptr));
+ Action.all (Ada_Widget.all);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error with
+ "Callback in Fl_Menu_ was supplied Widget pointer with no user data";
+ end Item_Hook;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Menu) is
+ begin
+ for Item of This.My_Items loop
+ Free_Item (Item);
+ end loop;
+ Extra_Final (Widget (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Menu) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_menu (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+ procedure Finalize
+ (This : in out Menu_Final_Controller) is
+ begin
+ if Null_Item /= Null_Pointer then
+ free_fl_menu_item (Null_Item);
+ Null_Item := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Menu;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Widget (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Menu) is
+ begin
+ This.Draw_Ptr := fl_menu_draw'Address;
+ This.Handle_Ptr := fl_menu_handle'Address;
+ This.Get_Item_Ptr := fl_menu_get_item'Address;
+ This.Value_Ptr := fl_menu_value'Address;
+ Wrapper (This.My_Find).Needs_Dealloc := False;
+ Wrapper (This.My_Pick).Needs_Dealloc := False;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Menu is
+ begin
+ return This : Menu do
+ This.Void_Ptr := new_fl_menu
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Menu is
+ begin
+ return This : Menu := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Add
+ (This : in out Menu;
+ Text : in String)
+ is
+ Added_Spot : Interfaces.C.int := fl_menu_add (This.Void_Ptr, Interfaces.C.To_C (Text));
+ begin
+ This.Adjust_Item_Store;
+ end Add;
+
+
+ function Add
+ (This : in out Menu;
+ Text : in String)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_menu_add (This.Void_Ptr, Interfaces.C.To_C (Text));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Add;
+
+
+ procedure Add
+ (This : in out Menu;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_menu_add2
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Add;
+
+
+ function Add
+ (This : in out Menu;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_menu_add2
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Add;
+
+
+ procedure Add
+ (This : in out Menu;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_menu_add3
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Add;
+
+
+ function Add
+ (This : in out Menu;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_menu_add3
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Add;
+
+
+ procedure Insert
+ (This : in out Menu;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_menu_insert
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Insert;
+
+
+ function Insert
+ (This : in out Menu;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_menu_insert
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Insert;
+
+
+ procedure Insert
+ (This : in out Menu;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_menu_insert2
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Insert;
+
+
+ function Insert
+ (This : in out Menu;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_menu_insert2
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.int (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Insert;
+
+
+ procedure Set_Items
+ (This : in out Menu;
+ Items : in FLTK.Menu_Items.Menu_Item_Array)
+ is
+ Pointers : aliased array (Items'First .. Items'Last + 1) of Storage.Integer_Address;
+ pragma Convention (C, Pointers);
+ begin
+ for Place in Pointers'First .. Pointers'Last - 1 loop
+ Pointers (Place) := Wrapper (Items (Place)).Void_Ptr;
+ end loop;
+ Pointers (Pointers'Last) := Null_Item;
+ fl_menu_copy (This.Void_Ptr, Storage.To_Integer (Pointers (Pointers'First)'Address));
+ This.Adjust_Item_Store;
+ end Set_Items;
+
+
+ procedure Use_Same_Items
+ (This : in out Menu;
+ Donor : in Menu'Class) is
+ begin
+ -- Donor menu() pointer will be obtained in C++
+ fl_menu_set_menu (This.Void_Ptr, Donor.Void_Ptr);
+ This.Adjust_Item_Store;
+ end Use_Same_Items;
+
+
+ procedure Remove
+ (This : in out Menu;
+ Place : in Index) is
+ begin
+ fl_menu_remove (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+ This.Adjust_Item_Store;
+ end Remove;
+
+
+ procedure Clear
+ (This : in out Menu) is
+ begin
+ for Item of This.My_Items loop
+ Free_Item (Item);
+ end loop;
+ This.My_Items.Clear;
+ fl_menu_clear (This.Void_Ptr);
+ end Clear;
+
+
+ procedure Clear_Submenu
+ (This : in out Menu;
+ Place : in Index)
+ is
+ Result : Interfaces.C.int := fl_menu_clear_submenu
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1);
+ begin
+ if Result = -1 then
+ raise No_Reference_Error;
+ else
+ pragma Assert (Result = 0);
+ This.Adjust_Item_Store;
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error with
+ "Call to Fl_Menu_::clear_submenu returned unexpected int result of " &
+ Interfaces.C.int'Image (Result);
+ end Clear_Submenu;
+
+
+
+
+ function Has_Item
+ (This : in Menu;
+ Place : in Index)
+ return Boolean is
+ begin
+ return Place in 1 .. This.Number_Of_Items;
+ end Has_Item;
+
+
+ function Has_Item
+ (Place : in Cursor)
+ return Boolean is
+ begin
+ return Place.My_Container.Has_Item (Place.My_Index);
+ end Has_Item;
+
+
+ function Item
+ (This : in Menu;
+ Place : in Index)
+ return FLTK.Menu_Items.Menu_Item_Reference
+ is
+ function my_get_item
+ (M : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ for my_get_item'Address use This.Get_Item_Ptr;
+ pragma Import (Ada, my_get_item);
+ begin
+ Wrapper (This.My_Items (Place).all).Void_Ptr :=
+ my_get_item (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+ return (Data => This.My_Items (Place).all'Unchecked_Access);
+ end Item;
+
+
+ function Item
+ (This : in Menu;
+ Place : in Cursor)
+ return FLTK.Menu_Items.Menu_Item_Reference is
+ begin
+ return This.Item (Place.My_Index);
+ end Item;
+
+
+ function Find_Item
+ (This : in Menu;
+ Name : in String)
+ return FLTK.Menu_Items.Menu_Item_Reference
+ is
+ Place : Extended_Index := This.Find_Index (Name);
+ begin
+ if Place = No_Index then
+ raise No_Reference_Error;
+ end if;
+ return This.Item (Place);
+ end Find_Item;
+
+
+ function Find_Item
+ (This : in Menu;
+ Action : in Widget_Callback)
+ return FLTK.Menu_Items.Menu_Item_Reference
+ is
+ Place : Extended_Index := This.Find_Index (Action);
+ begin
+ if Place = No_Index then
+ raise No_Reference_Error;
+ end if;
+ return This.Item (Place);
+ end Find_Item;
+
+
+ function Find_Index
+ (This : in Menu;
+ Name : in String)
+ return Extended_Index
+ is
+ Result : Interfaces.C.int := fl_menu_find_index (This.Void_Ptr, Interfaces.C.To_C (Name));
+ begin
+ return Extended_Index (Result + 1);
+ end Find_Index;
+
+
+ function Find_Index
+ (This : in Menu;
+ Item : in FLTK.Menu_Items.Menu_Item)
+ return Extended_Index
+ is
+ Result : Interfaces.C.int := fl_menu_find_index2 (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+ begin
+ return Extended_Index (Result + 1);
+ end Find_Index;
+
+
+ function Find_Index
+ (This : in Menu;
+ Action : in Widget_Callback)
+ return Extended_Index
+ is
+ Result : Interfaces.C.int;
+ begin
+ -- Don't worry, callbacks actually being stored in userdata is
+ -- taken into account on the C++ side.
+ Result := fl_menu_find_index3 (This.Void_Ptr, Callback_Convert.To_Address (Action));
+ return Extended_Index (Result + 1);
+ end Find_Index;
+
+
+ function Item_Pathname
+ (This : in Menu)
+ return String
+ is
+ Buffer : Interfaces.C.char_array :=
+ (0 .. Interfaces.C.size_t (Item_Path_Max) => Interfaces.C.nul);
+ Result : Interfaces.C.int := fl_menu_item_pathname
+ (This.Void_Ptr,
+ Buffer,
+ Interfaces.C.int (Item_Path_Max),
+ Null_Pointer);
+ begin
+ case Result is
+ when -1 => raise No_Reference_Error;
+ when -2 => raise Internal_FLTK_Error with "Item_Pathname buffer of " &
+ Integer'Image (Item_Path_Max) & " was not long enough";
+ when others =>
+ pragma Assert (Result = 0);
+ return Interfaces.C.To_Ada (Buffer);
+ end case;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error with
+ "Call to Fl_Menu_::item_pathname returned unexpected int result of " &
+ Interfaces.C.int'Image (Result);
+ end Item_Pathname;
+
+
+ function Item_Pathname
+ (This : in Menu;
+ Item : in FLTK.Menu_Items.Menu_Item)
+ return String
+ is
+ Buffer : Interfaces.C.char_array :=
+ (0 .. Interfaces.C.size_t (Item_Path_Max) => Interfaces.C.nul);
+ Result : Interfaces.C.int := fl_menu_item_pathname
+ (This.Void_Ptr,
+ Buffer,
+ Interfaces.C.int (Item_Path_Max),
+ Wrapper (Item).Void_Ptr);
+ begin
+ case Result is
+ when -1 => raise No_Reference_Error;
+ when -2 => raise Internal_FLTK_Error with "Item_Pathname buffer of " &
+ Integer'Image (Item_Path_Max) & " was not long enough";
+ when others =>
+ pragma Assert (Result = 0);
+ return Interfaces.C.To_Ada (Buffer);
+ end case;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error with
+ "Call to Fl_Menu_::item_pathname returned unexpected int result of " &
+ Interfaces.C.int'Image (Result);
+ end Item_Pathname;
+
+
+ function Number_Of_Items
+ (This : in Menu)
+ return Natural is
+ begin
+ return Natural (fl_menu_size (This.Void_Ptr));
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Call to Fl_Menu_::size returned unexpected negative result";
+ end Number_Of_Items;
+
+
+
+
+ function Iterate
+ (This : in Menu)
+ return Menu_Iterators.Reversible_Iterator'Class is
+ begin
+ return It : Iterator := (My_Container => This'Unrestricted_Access);
+ end Iterate;
+
+
+ function First
+ (Object : in Iterator)
+ return Cursor is
+ begin
+ return Cu : Cursor :=
+ (My_Container => Object.My_Container,
+ My_Index => 1);
+ end First;
+
+
+ function Next
+ (Object : in Iterator;
+ Place : in Cursor)
+ return Cursor is
+ begin
+ return Cu : Cursor :=
+ (My_Container => Place.My_Container,
+ My_Index => Place.My_Index + 1);
+ end Next;
+
+
+ function Last
+ (Object : in Iterator)
+ return Cursor is
+ begin
+ return Cu : Cursor :=
+ (My_Container => Object.My_Container,
+ My_Index => Object.My_Container.Number_Of_Items);
+ end Last;
+
+
+ function Previous
+ (Object : in Iterator;
+ Place : in Cursor)
+ return Cursor is
+ begin
+ return Cu : Cursor :=
+ (My_Container => Place.My_Container,
+ My_Index => Place.My_Index - 1);
+ end Previous;
+
+
+
+
+ function Chosen
+ (This : in Menu)
+ return FLTK.Menu_Items.Menu_Item_Reference
+ is
+ Place : Extended_Index := This.Chosen_Index;
+ begin
+ if Place = No_Index then
+ raise No_Reference_Error;
+ end if;
+ return This.Item (Place);
+ end Chosen;
+
+
+ function Chosen_Label
+ (This : in Menu)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_menu_text (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Chosen_Label;
+
+
+ function Chosen_Index
+ (This : in Menu)
+ return Extended_Index
+ is
+ function my_value
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_value'Address use This.Value_Ptr;
+ pragma Import (Ada, my_value);
+ begin
+ return Extended_Index (my_value (This.Void_Ptr) + 1);
+ end Chosen_Index;
+
+
+ procedure Set_Chosen
+ (This : in out Menu;
+ Item : in FLTK.Menu_Items.Menu_Item)
+ is
+ Ignore : Interfaces.C.int;
+ begin
+ Ignore := fl_menu_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+ end Set_Chosen;
+
+
+ function Set_Chosen
+ (This : in out Menu;
+ Item : in FLTK.Menu_Items.Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr) /= 0;
+ end Set_Chosen;
+
+
+ procedure Set_Chosen
+ (This : in out Menu;
+ Place : in Index)
+ is
+ Ignore : Interfaces.C.int;
+ begin
+ Ignore := fl_menu_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+ end Set_Chosen;
+
+
+ function Set_Chosen
+ (This : in out Menu;
+ Place : in Index)
+ return Boolean is
+ begin
+ return fl_menu_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1) /= 0;
+ end Set_Chosen;
+
+
+
+
+ procedure Set_Only
+ (This : in out Menu;
+ Item : in out FLTK.Menu_Items.Menu_Item) is
+ begin
+ fl_menu_setonly (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+ end Set_Only;
+
+
+ function Get_Label
+ (This : in Menu;
+ Place : in Index)
+ return String
+ is
+ Result : Interfaces.C.Strings.chars_ptr := fl_menu_text2
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1);
+ begin
+ if Result = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Result);
+ end if;
+ end Get_Label;
+
+
+ procedure Set_Label
+ (This : in out Menu;
+ Place : in Index;
+ Text : in String) is
+ begin
+ fl_menu_replace
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text));
+ end Set_Label;
+
+
+ procedure Set_Shortcut
+ (This : in out Menu;
+ Place : in Index;
+ Press : in Key_Combo) is
+ begin
+ fl_menu_shortcut
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ To_C (Press));
+ end Set_Shortcut;
+
+
+ function Get_Flags
+ (This : in Menu;
+ Place : in Index)
+ return Menu_Flag is
+ begin
+ return Menu_Flag (fl_menu_get_mode (This.Void_Ptr, Interfaces.C.int (Place) - 1));
+ end Get_Flags;
+
+
+ procedure Set_Flags
+ (This : in out Menu;
+ Place : in Index;
+ Flags : in Menu_Flag) is
+ begin
+ fl_menu_set_mode
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.int (Flags));
+ end Set_Flags;
+
+
+
+
+ function Get_Text_Color
+ (This : in Menu)
+ return Color is
+ begin
+ return Color (fl_menu_get_textcolor (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Menu;
+ To : in Color) is
+ begin
+ fl_menu_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Menu)
+ return Font_Kind
+ is
+ Result : Interfaces.C.int := fl_menu_get_textfont (This.Void_Ptr);
+ begin
+ return Font_Kind'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Menu_::textfont returned unexpected Font value of " &
+ Interfaces.C.int'Image (Result);
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Menu;
+ To : in Font_Kind) is
+ begin
+ fl_menu_set_textfont (This.Void_Ptr, Font_Kind'Pos (To));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Menu)
+ return Font_Size
+ is
+ Result : Interfaces.C.int := fl_menu_get_textsize (This.Void_Ptr);
+ begin
+ return Font_Size (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Menu_::textsize returned unexpected Size value of " &
+ Interfaces.C.int'Image (Result);
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Menu;
+ To : in Font_Size) is
+ begin
+ fl_menu_set_textsize (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Text_Size;
+
+
+
+
+ function Get_Down_Box
+ (This : in Menu)
+ return Box_Kind
+ is
+ Result : Interfaces.C.int := fl_menu_get_down_box (This.Void_Ptr);
+ begin
+ return Box_Kind'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Menu_::down_box returned unexpected Box value of " &
+ Interfaces.C.int'Image (Result);
+ end Get_Down_Box;
+
+
+ procedure Set_Down_Box
+ (This : in out Menu;
+ To : in Box_Kind) is
+ begin
+ fl_menu_set_down_box (This.Void_Ptr, Box_Kind'Pos (To));
+ end Set_Down_Box;
+
+
+ procedure Make_Global
+ (This : in out Menu) is
+ begin
+ fl_menu_global (This.Void_Ptr);
+ end Make_Global;
+
+
+ procedure Measure_Item
+ (This : in Menu;
+ Item : in Index;
+ W, H : out Integer) is
+ begin
+ W := Integer (fl_menu_measure
+ (This.Void_Ptr,
+ Interfaces.C.int (Item) - 1,
+ Interfaces.C.int (H)));
+ end Measure_Item;
+
+
+
+
+ function Popup
+ (This : in Menu;
+ X, Y : in Integer;
+ Title : in String := "";
+ Initial : in Extended_Index := No_Index)
+ return Extended_Index
+ is
+ C_Title : aliased Interfaces.C.char_array := Interfaces.C.To_C (Title);
+ Ptr : Storage.Integer_Address := fl_menu_popup
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ (if Title = ""
+ then Interfaces.C.Strings.Null_Ptr
+ else Interfaces.C.Strings.To_Chars_Ptr (C_Title'Unchecked_Access)),
+ Interfaces.C.int (Initial) - 1);
+ begin
+ return Extended_Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1);
+ end Popup;
+
+
+ function Pulldown
+ (This : in Menu;
+ X, Y, W, H : in Integer;
+ Initial : in Extended_Index := No_Index)
+ return Extended_Index
+ is
+ Ptr : Storage.Integer_Address := fl_menu_pulldown
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.int (Initial) - 1);
+ begin
+ return Extended_Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1);
+ end Pulldown;
+
+
+ procedure Picked
+ (This : in out Menu;
+ Item : in out FLTK.Menu_Items.Menu_Item)
+ is
+ Ignore : Storage.Integer_Address := fl_menu_picked
+ (This.Void_Ptr,
+ Wrapper (Item).Void_Ptr);
+ begin
+ null;
+ end Picked;
+
+
+ function Find_Shortcut
+ (This : in out Menu;
+ Require_Alt : in Boolean := False)
+ return access FLTK.Menu_Items.Menu_Item'Class
+ is
+ Tentative_Result : Storage.Integer_Address := fl_menu_find_shortcut
+ (This.Void_Ptr,
+ Null_Pointer,
+ Boolean'Pos (Require_Alt));
+ begin
+ if Tentative_Result = Null_Pointer then
+ return null;
+ else
+ Wrapper (This.My_Find).Void_Ptr := Tentative_Result;
+ return This.My_Find'Unchecked_Access;
+ end if;
+ end Find_Shortcut;
+
+
+ function Find_Shortcut
+ (This : in out Menu;
+ Place : out Extended_Index;
+ Require_Alt : in Boolean := False)
+ return access FLTK.Menu_Items.Menu_Item'Class
+ is
+ C_Place : Interfaces.C.int;
+ Tentative_Result : Storage.Integer_Address := fl_menu_find_shortcut
+ (This.Void_Ptr,
+ Storage.To_Integer (C_Place'Address),
+ Boolean'Pos (Require_Alt));
+ begin
+ if Tentative_Result = Null_Pointer then
+ Place := No_Index;
+ return null;
+ else
+ Wrapper (This.My_Find).Void_Ptr := Tentative_Result;
+ Place := Index (C_Place + 1);
+ return This.My_Find'Unchecked_Access;
+ end if;
+ end Find_Shortcut;
+
+
+ function Test_Shortcut
+ (This : in out Menu)
+ return access FLTK.Menu_Items.Menu_Item'Class
+ is
+ Tentative_Pick : Storage.Integer_Address := fl_menu_test_shortcut (This.Void_Ptr);
+ begin
+ if Tentative_Pick = Null_Pointer then
+ return null;
+ else
+ Wrapper (This.My_Pick).Void_Ptr := Tentative_Pick;
+ return This.My_Pick'Unchecked_Access;
+ end if;
+ end Test_Shortcut;
+
+
+
+
+ procedure Resize
+ (This : in out Menu;
+ W, H : in Integer) is
+ begin
+ fl_menu_size2
+ (This.Void_Ptr,
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+
+
+ procedure Draw_Item
+ (This : in out Menu;
+ Item : in Index;
+ X, Y, W, H : in Integer;
+ Selected : in Boolean := False) is
+ begin
+ fl_menu_draw_item
+ (This.Void_Ptr,
+ Interfaces.C.int (Item) - 1,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Boolean'Pos (Selected));
+ end Draw_Item;
+
+
+end FLTK.Widgets.Menus;
+
+
diff --git a/body/fltk-widgets-positioners.adb b/body/fltk-widgets-positioners.adb
new file mode 100644
index 0000000..053d731
--- /dev/null
+++ b/body/fltk-widgets-positioners.adb
@@ -0,0 +1,538 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+
+package body FLTK.Widgets.Positioners is
+
+
+ package Chk renames Ada.Assertions;
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_positioner
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_positioner, "new_fl_positioner");
+ pragma Inline (new_fl_positioner);
+
+ procedure free_fl_positioner
+ (P : in Storage.Integer_Address);
+ pragma Import (C, free_fl_positioner, "free_fl_positioner");
+ pragma Inline (free_fl_positioner);
+
+
+
+
+ function fl_positioner_set_value
+ (P : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.double)
+ return Interfaces.C.int;
+ pragma Import (C, fl_positioner_set_value, "fl_positioner_set_value");
+ pragma Inline (fl_positioner_set_value);
+
+
+
+
+ procedure fl_positioner_xbounds
+ (P : in Storage.Integer_Address;
+ L, H : in Interfaces.C.double);
+ pragma Import (C, fl_positioner_xbounds, "fl_positioner_xbounds");
+ pragma Inline (fl_positioner_xbounds);
+
+ procedure fl_positioner_xstep
+ (P : in Storage.Integer_Address;
+ A : in Interfaces.C.double);
+ pragma Import (C, fl_positioner_xstep, "fl_positioner_xstep");
+ pragma Inline (fl_positioner_xstep);
+
+ function fl_positioner_get_xminimum
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_positioner_get_xminimum, "fl_positioner_get_xminimum");
+ pragma Inline (fl_positioner_get_xminimum);
+
+ procedure fl_positioner_set_xminimum
+ (P : in Storage.Integer_Address;
+ A : in Interfaces.C.double);
+ pragma Import (C, fl_positioner_set_xminimum, "fl_positioner_set_xminimum");
+ pragma Inline (fl_positioner_set_xminimum);
+
+ function fl_positioner_get_xmaximum
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_positioner_get_xmaximum, "fl_positioner_get_xmaximum");
+ pragma Inline (fl_positioner_get_xmaximum);
+
+ procedure fl_positioner_set_xmaximum
+ (P : in Storage.Integer_Address;
+ A : in Interfaces.C.double);
+ pragma Import (C, fl_positioner_set_xmaximum, "fl_positioner_set_xmaximum");
+ pragma Inline (fl_positioner_set_xmaximum);
+
+ function fl_positioner_get_xvalue
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_positioner_get_xvalue, "fl_positioner_get_xvalue");
+ pragma Inline (fl_positioner_get_xvalue);
+
+ function fl_positioner_set_xvalue
+ (P : in Storage.Integer_Address;
+ V : in Interfaces.C.double)
+ return Interfaces.C.int;
+ pragma Import (C, fl_positioner_set_xvalue, "fl_positioner_set_xvalue");
+ pragma Inline (fl_positioner_set_xvalue);
+
+
+
+
+ procedure fl_positioner_ybounds
+ (P : in Storage.Integer_Address;
+ L, H : in Interfaces.C.double);
+ pragma Import (C, fl_positioner_ybounds, "fl_positioner_ybounds");
+ pragma Inline (fl_positioner_ybounds);
+
+ procedure fl_positioner_ystep
+ (P : in Storage.Integer_Address;
+ A : in Interfaces.C.double);
+ pragma Import (C, fl_positioner_ystep, "fl_positioner_ystep");
+ pragma Inline (fl_positioner_ystep);
+
+ function fl_positioner_get_yminimum
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_positioner_get_yminimum, "fl_positioner_get_yminimum");
+ pragma Inline (fl_positioner_get_yminimum);
+
+ procedure fl_positioner_set_yminimum
+ (P : in Storage.Integer_Address;
+ A : in Interfaces.C.double);
+ pragma Import (C, fl_positioner_set_yminimum, "fl_positioner_set_yminimum");
+ pragma Inline (fl_positioner_set_yminimum);
+
+ function fl_positioner_get_ymaximum
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_positioner_get_ymaximum, "fl_positioner_get_ymaximum");
+ pragma Inline (fl_positioner_get_ymaximum);
+
+ procedure fl_positioner_set_ymaximum
+ (P : in Storage.Integer_Address;
+ A : in Interfaces.C.double);
+ pragma Import (C, fl_positioner_set_ymaximum, "fl_positioner_set_ymaximum");
+ pragma Inline (fl_positioner_set_ymaximum);
+
+ function fl_positioner_get_yvalue
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_positioner_get_yvalue, "fl_positioner_get_yvalue");
+ pragma Inline (fl_positioner_get_yvalue);
+
+ function fl_positioner_set_yvalue
+ (P : in Storage.Integer_Address;
+ V : in Interfaces.C.double)
+ return Interfaces.C.int;
+ pragma Import (C, fl_positioner_set_yvalue, "fl_positioner_set_yvalue");
+ pragma Inline (fl_positioner_set_yvalue);
+
+
+
+
+ procedure fl_positioner_draw
+ (P : in Storage.Integer_Address);
+ pragma Import (C, fl_positioner_draw, "fl_positioner_draw");
+ pragma Inline (fl_positioner_draw);
+
+ procedure fl_positioner_draw2
+ (P : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_positioner_draw2, "fl_positioner_draw2");
+ pragma Inline (fl_positioner_draw2);
+
+ function fl_positioner_handle
+ (P : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_positioner_handle, "fl_positioner_handle");
+ pragma Inline (fl_positioner_handle);
+
+ function fl_positioner_handle2
+ (P : in Storage.Integer_Address;
+ E, X, Y, W, H : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_positioner_handle2, "fl_positioner_handle2");
+ pragma Inline (fl_positioner_handle2);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Positioner) is
+ begin
+ Extra_Final (Widget (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Positioner) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_positioner (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Positioner;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Widget (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Positioner) is
+ begin
+ This.Draw_Ptr := fl_positioner_draw'Address;
+ This.Handle_Ptr := fl_positioner_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Positioner is
+ begin
+ return This : Positioner do
+ This.Void_Ptr := new_fl_positioner
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Positioner is
+ begin
+ return This : Positioner := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Get_Coords
+ (This : in Positioner;
+ X, Y : out Long_Float) is
+ begin
+ X := This.Get_Ecks;
+ Y := This.Get_Why;
+ end Get_Coords;
+
+
+ procedure Set_Coords
+ (This : in out Positioner;
+ X, Y : in Long_Float)
+ is
+ Result : Interfaces.C.int := fl_positioner_set_value
+ (This.Void_Ptr,
+ Interfaces.C.double (X),
+ Interfaces.C.double (Y));
+ begin
+ pragma Assert (Result in 0 .. 1);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Set_Coords;
+
+
+ function Set_Coords
+ (This : in out Positioner;
+ X, Y : in Long_Float)
+ return Boolean
+ is
+ Result : Interfaces.C.int := fl_positioner_set_value
+ (This.Void_Ptr,
+ Interfaces.C.double (X),
+ Interfaces.C.double (Y));
+ begin
+ return Boolean'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error;
+ end Set_Coords;
+
+
+
+
+ procedure Set_Ecks_Bounds
+ (This : in out Positioner;
+ Low, High : in Long_Float) is
+ begin
+ fl_positioner_xbounds
+ (This.Void_Ptr,
+ Interfaces.C.double (Low),
+ Interfaces.C.double (High));
+ end Set_Ecks_Bounds;
+
+
+ procedure Set_Ecks_Step
+ (This : in out Positioner;
+ Value : in Long_Float) is
+ begin
+ fl_positioner_xstep (This.Void_Ptr, Interfaces.C.double (Value));
+ end Set_Ecks_Step;
+
+
+ function Get_Ecks_Minimum
+ (This : in Positioner)
+ return Long_Float is
+ begin
+ return Long_Float (fl_positioner_get_xminimum (This.Void_Ptr));
+ end Get_Ecks_Minimum;
+
+
+ procedure Set_Ecks_Minimum
+ (This : in out Positioner;
+ Value : in Long_Float) is
+ begin
+ fl_positioner_set_xminimum (This.Void_Ptr, Interfaces.C.double (Value));
+ end Set_Ecks_Minimum;
+
+
+ function Get_Ecks_Maximum
+ (This : in Positioner)
+ return Long_Float is
+ begin
+ return Long_Float (fl_positioner_get_xmaximum (This.Void_Ptr));
+ end Get_Ecks_Maximum;
+
+
+ procedure Set_Ecks_Maximum
+ (This : in out Positioner;
+ Value : in Long_Float) is
+ begin
+ fl_positioner_set_xmaximum (This.Void_Ptr, Interfaces.C.double (Value));
+ end Set_Ecks_Maximum;
+
+
+ function Get_Ecks
+ (This : in Positioner)
+ return Long_Float is
+ begin
+ return Long_Float (fl_positioner_get_xvalue (This.Void_Ptr));
+ end Get_Ecks;
+
+
+ procedure Set_Ecks
+ (This : in out Positioner;
+ Value : in Long_Float)
+ is
+ Result : Interfaces.C.int := fl_positioner_set_xvalue
+ (This.Void_Ptr,
+ Interfaces.C.double (Value));
+ begin
+ pragma Assert (Result in 0 .. 1);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Set_Ecks;
+
+
+ function Set_Ecks
+ (This : in out Positioner;
+ Value : in Long_Float)
+ return Boolean
+ is
+ Result : Interfaces.C.int := fl_positioner_set_xvalue
+ (This.Void_Ptr,
+ Interfaces.C.double (Value));
+ begin
+ return Boolean'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error;
+ end Set_Ecks;
+
+
+
+
+ procedure Set_Why_Bounds
+ (This : in out Positioner;
+ Low, High : in Long_Float) is
+ begin
+ fl_positioner_ybounds
+ (This.Void_Ptr,
+ Interfaces.C.double (Low),
+ Interfaces.C.double (High));
+ end Set_Why_Bounds;
+
+
+ procedure Set_Why_Step
+ (This : in out Positioner;
+ Value : in Long_Float) is
+ begin
+ fl_positioner_ystep (This.Void_Ptr, Interfaces.C.double (Value));
+ end Set_Why_Step;
+
+
+ function Get_Why_Minimum
+ (This : in Positioner)
+ return Long_Float is
+ begin
+ return Long_Float (fl_positioner_get_yminimum (This.Void_Ptr));
+ end Get_Why_Minimum;
+
+
+ procedure Set_Why_Minimum
+ (This : in out Positioner;
+ Value : in Long_Float) is
+ begin
+ fl_positioner_set_yminimum (This.Void_Ptr, Interfaces.C.double (Value));
+ end Set_Why_Minimum;
+
+
+ function Get_Why_Maximum
+ (This : in Positioner)
+ return Long_Float is
+ begin
+ return Long_Float (fl_positioner_get_ymaximum (This.Void_Ptr));
+ end Get_Why_Maximum;
+
+
+ procedure Set_Why_Maximum
+ (This : in out Positioner;
+ Value : in Long_Float) is
+ begin
+ fl_positioner_set_ymaximum (This.Void_Ptr, Interfaces.C.double (Value));
+ end Set_Why_Maximum;
+
+
+ function Get_Why
+ (This : in Positioner)
+ return Long_Float is
+ begin
+ return Long_Float (fl_positioner_get_yvalue (This.Void_Ptr));
+ end Get_Why;
+
+
+ procedure Set_Why
+ (This : in out Positioner;
+ Value : in Long_Float)
+ is
+ Result : Interfaces.C.int := fl_positioner_set_yvalue
+ (This.Void_Ptr,
+ Interfaces.C.double (Value));
+ begin
+ pragma Assert (Result in 0 .. 1);
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Set_Why;
+
+
+ function Set_Why
+ (This : in out Positioner;
+ Value : in Long_Float)
+ return Boolean
+ is
+ Result : Interfaces.C.int := fl_positioner_set_yvalue
+ (This.Void_Ptr,
+ Interfaces.C.double (Value));
+ begin
+ return Boolean'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error;
+ end Set_Why;
+
+
+
+
+ procedure Draw
+ (This : in out Positioner) is
+ begin
+ Widget (This).Draw;
+ end Draw;
+
+
+ procedure Draw
+ (This : in out Positioner;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_positioner_draw2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Draw;
+
+
+ function Handle
+ (This : in out Positioner;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Widget (This).Handle (Event);
+ end Handle;
+
+
+ function Handle
+ (This : in out Positioner;
+ Event : in Event_Kind;
+ X, Y, W, H : in Integer)
+ return Event_Outcome is
+ begin
+ return Event_Outcome'Val (fl_positioner_handle2
+ (This.Void_Ptr,
+ Event_Kind'Pos (Event),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H)));
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error;
+ end Handle;
+
+
+end FLTK.Widgets.Positioners;
+
+
diff --git a/body/fltk-widgets-progress_bars.adb b/body/fltk-widgets-progress_bars.adb
new file mode 100644
index 0000000..b82fef6
--- /dev/null
+++ b/body/fltk-widgets-progress_bars.adb
@@ -0,0 +1,232 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Progress_Bars is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_progress
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_progress, "new_fl_progress");
+ pragma Inline (new_fl_progress);
+
+ procedure free_fl_progress
+ (P : in Storage.Integer_Address);
+ pragma Import (C, free_fl_progress, "free_fl_progress");
+ pragma Inline (free_fl_progress);
+
+
+
+
+ function fl_progress_get_minimum
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.C_float;
+ pragma Import (C, fl_progress_get_minimum, "fl_progress_get_minimum");
+ pragma Inline (fl_progress_get_minimum);
+
+ procedure fl_progress_set_minimum
+ (P : in Storage.Integer_Address;
+ T : in Interfaces.C.C_float);
+ pragma Import (C, fl_progress_set_minimum, "fl_progress_set_minimum");
+ pragma Inline (fl_progress_set_minimum);
+
+ function fl_progress_get_maximum
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.C_float;
+ pragma Import (C, fl_progress_get_maximum, "fl_progress_get_maximum");
+ pragma Inline (fl_progress_get_maximum);
+
+ procedure fl_progress_set_maximum
+ (P : in Storage.Integer_Address;
+ T : in Interfaces.C.C_float);
+ pragma Import (C, fl_progress_set_maximum, "fl_progress_set_maximum");
+ pragma Inline (fl_progress_set_maximum);
+
+ function fl_progress_get_value
+ (P : in Storage.Integer_Address)
+ return Interfaces.C.C_float;
+ pragma Import (C, fl_progress_get_value, "fl_progress_get_value");
+ pragma Inline (fl_progress_get_value);
+
+ procedure fl_progress_set_value
+ (P : in Storage.Integer_Address;
+ T : in Interfaces.C.C_float);
+ pragma Import (C, fl_progress_set_value, "fl_progress_set_value");
+ pragma Inline (fl_progress_set_value);
+
+
+
+
+ procedure fl_progress_draw
+ (P : in Storage.Integer_Address);
+ pragma Import (C, fl_progress_draw, "fl_progress_draw");
+ pragma Inline (fl_progress_draw);
+
+ function fl_progress_handle
+ (P : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_progress_handle, "fl_progress_handle");
+ pragma Inline (fl_progress_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Progress_Bar) is
+ begin
+ Extra_Final (Widget (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Progress_Bar) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_progress (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Progress_Bar;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Widget (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Progress_Bar) is
+ begin
+ This.Draw_Ptr := fl_progress_draw'Address;
+ This.Handle_Ptr := fl_progress_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Progress_Bar is
+ begin
+ return This : Progress_Bar do
+ This.Void_Ptr := new_fl_progress
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Progress_Bar is
+ begin
+ return This : Progress_Bar := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Minimum
+ (This : in Progress_Bar)
+ return Float is
+ begin
+ return Float (fl_progress_get_minimum (This.Void_Ptr));
+ end Get_Minimum;
+
+
+ procedure Set_Minimum
+ (This : in out Progress_Bar;
+ To : in Float) is
+ begin
+ fl_progress_set_minimum (This.Void_Ptr, Interfaces.C.C_float (To));
+ end Set_Minimum;
+
+
+ function Get_Maximum
+ (This : in Progress_Bar)
+ return Float is
+ begin
+ return Float (fl_progress_get_maximum (This.Void_Ptr));
+ end Get_Maximum;
+
+
+ procedure Set_Maximum
+ (This : in out Progress_Bar;
+ To : in Float) is
+ begin
+ fl_progress_set_maximum (This.Void_Ptr, Interfaces.C.C_float (To));
+ end Set_Maximum;
+
+
+ function Get_Value
+ (This : in Progress_Bar)
+ return Float is
+ begin
+ return Float (fl_progress_get_value (This.Void_Ptr));
+ end Get_Value;
+
+
+ procedure Set_Value
+ (This : in out Progress_Bar;
+ To : in Float) is
+ begin
+ fl_progress_set_value (This.Void_Ptr, Interfaces.C.C_float (To));
+ end Set_Value;
+
+
+
+
+ procedure Draw
+ (This : in out Progress_Bar) is
+ begin
+ Widget (This).Draw;
+ end Draw;
+
+
+end FLTK.Widgets.Progress_Bars;
+
+
diff --git a/body/fltk-widgets-valuators-adjusters.adb b/body/fltk-widgets-valuators-adjusters.adb
new file mode 100644
index 0000000..89294e0
--- /dev/null
+++ b/body/fltk-widgets-valuators-adjusters.adb
@@ -0,0 +1,201 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Valuators.Adjusters is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_adjuster
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_adjuster, "new_fl_adjuster");
+ pragma Inline (new_fl_adjuster);
+
+ procedure free_fl_adjuster
+ (A : in Storage.Integer_Address);
+ pragma Import (C, free_fl_adjuster, "free_fl_adjuster");
+ pragma Inline (free_fl_adjuster);
+
+
+
+
+ function fl_adjuster_is_soft
+ (A : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_adjuster_is_soft, "fl_adjuster_is_soft");
+ pragma Inline (fl_adjuster_is_soft);
+
+ procedure fl_adjuster_set_soft
+ (A : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_adjuster_set_soft, "fl_adjuster_set_soft");
+ pragma Inline (fl_adjuster_set_soft);
+
+
+
+
+ procedure fl_adjuster_value_damage
+ (A : in Storage.Integer_Address);
+ pragma Import (C, fl_adjuster_value_damage, "fl_adjuster_value_damage");
+ pragma Inline (fl_adjuster_value_damage);
+
+ procedure fl_adjuster_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_adjuster_draw, "fl_adjuster_draw");
+ pragma Inline (fl_adjuster_draw);
+
+ function fl_adjuster_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_adjuster_handle, "fl_adjuster_handle");
+ pragma Inline (fl_adjuster_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Adjuster) is
+ begin
+ Extra_Final (Valuator (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Adjuster) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_adjuster (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Adjuster;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Valuator (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Adjuster) is
+ begin
+ This.Draw_Ptr := fl_adjuster_draw'Address;
+ This.Handle_Ptr := fl_adjuster_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Adjuster is
+ begin
+ return This : Adjuster do
+ This.Void_Ptr := new_fl_adjuster
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Adjuster is
+ begin
+ return This : Adjuster := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Is_Soft
+ (This : in Adjuster)
+ return Boolean is
+ begin
+ return fl_adjuster_is_soft (This.Void_Ptr) /= 0;
+ end Is_Soft;
+
+
+ procedure Set_Soft
+ (This : in out Adjuster;
+ To : in Boolean) is
+ begin
+ fl_adjuster_set_soft (This.Void_Ptr, Boolean'Pos (To));
+ end Set_Soft;
+
+
+
+
+ procedure Value_Damage
+ (This : in out Adjuster) is
+ begin
+ fl_adjuster_value_damage (This.Void_Ptr);
+ end Value_Damage;
+
+
+ procedure Draw
+ (This : in out Adjuster) is
+ begin
+ Valuator (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Adjuster;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Valuator (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Valuators.Adjusters;
+
+
diff --git a/body/fltk-widgets-valuators-counters-simple.adb b/body/fltk-widgets-valuators-counters-simple.adb
new file mode 100644
index 0000000..f1d39b8
--- /dev/null
+++ b/body/fltk-widgets-valuators-counters-simple.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Counters.Simple is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_simple_counter
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_simple_counter, "new_fl_simple_counter");
+ pragma Inline (new_fl_simple_counter);
+
+ procedure free_fl_simple_counter
+ (A : in Storage.Integer_Address);
+ pragma Import (C, free_fl_simple_counter, "free_fl_simple_counter");
+ pragma Inline (free_fl_simple_counter);
+
+
+
+
+ procedure fl_simple_counter_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_simple_counter_draw, "fl_simple_counter_draw");
+ pragma Inline (fl_simple_counter_draw);
+
+ function fl_simple_counter_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_simple_counter_handle, "fl_simple_counter_handle");
+ pragma Inline (fl_simple_counter_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Simple_Counter) is
+ begin
+ Extra_Final (Counter (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Simple_Counter) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_simple_counter (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Simple_Counter;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Counter (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Simple_Counter) is
+ begin
+ This.Draw_Ptr := fl_simple_counter_draw'Address;
+ This.Handle_Ptr := fl_simple_counter_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Simple_Counter is
+ begin
+ return This : Simple_Counter do
+ This.Void_Ptr := new_fl_simple_counter
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Simple_Counter is
+ begin
+ return This : Simple_Counter := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Valuators.Counters.Simple;
+
+
diff --git a/body/fltk-widgets-valuators-counters.adb b/body/fltk-widgets-valuators-counters.adb
new file mode 100644
index 0000000..e04e180
--- /dev/null
+++ b/body/fltk-widgets-valuators-counters.adb
@@ -0,0 +1,344 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Counters is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_counter
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_counter, "new_fl_counter");
+ pragma Inline (new_fl_counter);
+
+ procedure free_fl_counter
+ (A : in Storage.Integer_Address);
+ pragma Import (C, free_fl_counter, "free_fl_counter");
+ pragma Inline (free_fl_counter);
+
+
+
+
+ function fl_counter_get_step
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_counter_get_step, "fl_counter_get_step");
+ pragma Inline (fl_counter_get_step);
+
+ procedure fl_counter_set_step_top
+ (C : in Storage.Integer_Address;
+ T : in Interfaces.C.double);
+ pragma Import (C, fl_counter_set_step_top, "fl_counter_set_step_top");
+ pragma Inline (fl_counter_set_step_top);
+
+ procedure fl_counter_set_lstep
+ (C : in Storage.Integer_Address;
+ T : in Interfaces.C.double);
+ pragma Import (C, fl_counter_set_lstep, "fl_counter_set_lstep");
+ pragma Inline (fl_counter_set_lstep);
+
+ procedure fl_counter_set_step_both
+ (C : in Storage.Integer_Address;
+ S, L : in Interfaces.C.double);
+ pragma Import (C, fl_counter_set_step_both, "fl_counter_set_step_both");
+ pragma Inline (fl_counter_set_step_both);
+
+
+
+
+ function fl_counter_get_textcolor
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_counter_get_textcolor, "fl_counter_get_textcolor");
+ pragma Inline (fl_counter_get_textcolor);
+
+ procedure fl_counter_set_textcolor
+ (C : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned);
+ pragma Import (C, fl_counter_set_textcolor, "fl_counter_set_textcolor");
+ pragma Inline (fl_counter_set_textcolor);
+
+ function fl_counter_get_textfont
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_counter_get_textfont, "fl_counter_get_textfont");
+ pragma Inline (fl_counter_get_textfont);
+
+ procedure fl_counter_set_textfont
+ (C : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_counter_set_textfont, "fl_counter_set_textfont");
+ pragma Inline (fl_counter_set_textfont);
+
+ function fl_counter_get_textsize
+ (C : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_counter_get_textsize, "fl_counter_get_textsize");
+ pragma Inline (fl_counter_get_textsize);
+
+ procedure fl_counter_set_textsize
+ (C : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_counter_set_textsize, "fl_counter_set_textsize");
+ pragma Inline (fl_counter_set_textsize);
+
+
+
+
+ procedure fl_counter_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_counter_draw, "fl_counter_draw");
+ pragma Inline (fl_counter_draw);
+
+ function fl_counter_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_counter_handle, "fl_counter_handle");
+ pragma Inline (fl_counter_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Counter) is
+ begin
+ Extra_Final (Valuator (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Counter) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_counter (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Counter;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Valuator (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Counter) is
+ begin
+ This.Draw_Ptr := fl_counter_draw'Address;
+ This.Handle_Ptr := fl_counter_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Counter is
+ begin
+ return This : Counter do
+ This.Void_Ptr := new_fl_counter
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Counter is
+ begin
+ return This : Counter := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Step
+ (This : in Counter)
+ return Long_Float is
+ begin
+ return Long_Float (fl_counter_get_step (This.Void_Ptr));
+ end Get_Step;
+
+
+ procedure Set_Step_Top
+ (This : in out Counter;
+ To : in Long_Float) is
+ begin
+ fl_counter_set_step_top (This.Void_Ptr, Interfaces.C.double (To));
+ end Set_Step_Top;
+
+
+ function Get_Long_Step
+ (This : in Counter)
+ return Long_Float is
+ begin
+ return This.Long_Step;
+ end Get_Long_Step;
+
+
+ procedure Set_Long_Step
+ (This : in out Counter;
+ To : in Long_Float) is
+ begin
+ This.Long_Step := To;
+ fl_counter_set_lstep (This.Void_Ptr, Interfaces.C.double (To));
+ end Set_Long_Step;
+
+
+ procedure Set_Step_Both
+ (This : in out Counter;
+ Short, Long : in Long_Float) is
+ begin
+ fl_counter_set_step_both
+ (This.Void_Ptr,
+ Interfaces.C.double (Short),
+ Interfaces.C.double (Long));
+ end Set_Step_Both;
+
+
+
+
+ function Get_Text_Color
+ (This : in Counter)
+ return Color is
+ begin
+ return Color (fl_counter_get_textcolor (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Counter;
+ To : in Color) is
+ begin
+ fl_counter_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Counter)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_counter_get_textfont (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Counter;
+ To : in Font_Kind) is
+ begin
+ fl_counter_set_textfont (This.Void_Ptr, Font_Kind'Pos (To));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Counter)
+ return Font_Size is
+ begin
+ return Font_Size (fl_counter_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Counter;
+ To : in Font_Size) is
+ begin
+ fl_counter_set_textsize (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Text_Size;
+
+
+
+
+ procedure Draw
+ (This : in out Counter) is
+ begin
+ Valuator (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Counter;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Valuator (This).Handle (Event);
+ end Handle;
+
+
+
+
+ function Get_Kind
+ (This : in out Counter)
+ return Counter_Kind
+ is
+ Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr);
+ begin
+ return Counter_Kind'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Counter::type returned unexpected unsigned char value of " &
+ Interfaces.C.unsigned_char'Image (Result);
+ end Get_Kind;
+
+
+ package body Extra is
+
+ procedure Set_Kind
+ (This : in out Counter;
+ Value : in Counter_Kind) is
+ begin
+ fl_widget_set_type (This.Void_Ptr, Counter_Kind'Pos (Value));
+ end Set_Kind;
+
+ pragma Inline (Set_Kind);
+
+ end Extra;
+
+
+end FLTK.Widgets.Valuators.Counters;
+
+
diff --git a/body/fltk-widgets-valuators-dials-fill.adb b/body/fltk-widgets-valuators-dials-fill.adb
new file mode 100644
index 0000000..ba378be
--- /dev/null
+++ b/body/fltk-widgets-valuators-dials-fill.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Dials.Fill is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_fill_dial
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_fill_dial, "new_fl_fill_dial");
+ pragma Inline (new_fl_fill_dial);
+
+ procedure free_fl_fill_dial
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_fill_dial, "free_fl_fill_dial");
+ pragma Inline (free_fl_fill_dial);
+
+
+
+
+ procedure fl_fill_dial_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_fill_dial_draw, "fl_fill_dial_draw");
+ pragma Inline (fl_fill_dial_draw);
+
+ function fl_fill_dial_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_fill_dial_handle, "fl_fill_dial_handle");
+ pragma Inline (fl_fill_dial_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Fill_Dial) is
+ begin
+ Extra_Final (Dial (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Fill_Dial) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_fill_dial (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Fill_Dial;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Dial (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Fill_Dial) is
+ begin
+ This.Draw_Ptr := fl_fill_dial_draw'Address;
+ This.Handle_Ptr := fl_fill_dial_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Fill_Dial is
+ begin
+ return This : Fill_Dial do
+ This.Void_Ptr := new_fl_fill_dial
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Fill_Dial is
+ begin
+ return This : Fill_Dial := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Valuators.Dials.Fill;
+
+
diff --git a/body/fltk-widgets-valuators-dials-line.adb b/body/fltk-widgets-valuators-dials-line.adb
new file mode 100644
index 0000000..c20a828
--- /dev/null
+++ b/body/fltk-widgets-valuators-dials-line.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Dials.Line is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_line_dial
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_line_dial, "new_fl_line_dial");
+ pragma Inline (new_fl_line_dial);
+
+ procedure free_fl_line_dial
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_line_dial, "free_fl_line_dial");
+ pragma Inline (free_fl_line_dial);
+
+
+
+
+ procedure fl_line_dial_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_line_dial_draw, "fl_line_dial_draw");
+ pragma Inline (fl_line_dial_draw);
+
+ function fl_line_dial_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_line_dial_handle, "fl_line_dial_handle");
+ pragma Inline (fl_line_dial_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Line_Dial) is
+ begin
+ Extra_Final (Dial (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Line_Dial) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_line_dial (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Line_Dial;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Dial (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Line_Dial) is
+ begin
+ This.Draw_Ptr := fl_line_dial_draw'Address;
+ This.Handle_Ptr := fl_line_dial_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Line_Dial is
+ begin
+ return This : Line_Dial do
+ This.Void_Ptr := new_fl_line_dial
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Line_Dial is
+ begin
+ return This : Line_Dial := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Valuators.Dials.Line;
+
+
diff --git a/body/fltk-widgets-valuators-dials.adb b/body/fltk-widgets-valuators-dials.adb
new file mode 100644
index 0000000..6dc9e69
--- /dev/null
+++ b/body/fltk-widgets-valuators-dials.adb
@@ -0,0 +1,319 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Dials is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_dial
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_dial, "new_fl_dial");
+ pragma Inline (new_fl_dial);
+
+ procedure free_fl_dial
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_dial, "free_fl_dial");
+ pragma Inline (free_fl_dial);
+
+
+
+
+ function fl_dial_get_angle1
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.short;
+ pragma Import (C, fl_dial_get_angle1, "fl_dial_get_angle1");
+ pragma Inline (fl_dial_get_angle1);
+
+ procedure fl_dial_set_angle1
+ (D : in Storage.Integer_Address;
+ T : in Interfaces.C.short);
+ pragma Import (C, fl_dial_set_angle1, "fl_dial_set_angle1");
+ pragma Inline (fl_dial_set_angle1);
+
+ function fl_dial_get_angle2
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.short;
+ pragma Import (C, fl_dial_get_angle2, "fl_dial_get_angle2");
+ pragma Inline (fl_dial_get_angle2);
+
+ procedure fl_dial_set_angle2
+ (D : in Storage.Integer_Address;
+ T : in Interfaces.C.short);
+ pragma Import (C, fl_dial_set_angle2, "fl_dial_set_angle2");
+ pragma Inline (fl_dial_set_angle2);
+
+ procedure fl_dial_set_angles
+ (D : in Storage.Integer_Address;
+ A, B : in Interfaces.C.short);
+ pragma Import (C, fl_dial_set_angles, "fl_dial_set_angles");
+ pragma Inline (fl_dial_set_angles);
+
+
+
+
+ procedure fl_dial_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_dial_draw, "fl_dial_draw");
+ pragma Inline (fl_dial_draw);
+
+ procedure fl_dial_draw2
+ (D : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_dial_draw2, "fl_dial_draw2");
+ pragma Inline (fl_dial_draw2);
+
+ function fl_dial_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_dial_handle, "fl_dial_handle");
+ pragma Inline (fl_dial_handle);
+
+ function fl_dial_handle2
+ (D : in Storage.Integer_Address;
+ E, X, Y, W, H : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_dial_handle2, "fl_dial_handle2");
+ pragma Inline (fl_dial_handle2);
+
+
+
+
+ function fl_widget_get_type
+ (D : in Storage.Integer_Address)
+ return Interfaces.C.unsigned_char;
+ pragma Import (C, fl_widget_get_type, "fl_widget_get_type");
+ pragma Inline (fl_widget_get_type);
+
+ procedure fl_widget_set_type
+ (D : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_widget_set_type, "fl_widget_set_type");
+ pragma Inline (fl_widget_set_type);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Dial) is
+ begin
+ Extra_Final (Valuator (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Dial) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_dial (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Dial;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Valuator (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Dial) is
+ begin
+ This.Draw_Ptr := fl_dial_draw'Address;
+ This.Handle_Ptr := fl_dial_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Dial is
+ begin
+ return This : Dial do
+ This.Void_Ptr := new_fl_dial
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Dial is
+ begin
+ return This : Dial := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_First_Angle
+ (This : in Dial)
+ return Short_Integer is
+ begin
+ return Short_Integer (fl_dial_get_angle1 (This.Void_Ptr));
+ end Get_First_Angle;
+
+
+ procedure Set_First_Angle
+ (This : in out Dial;
+ To : in Short_Integer) is
+ begin
+ fl_dial_set_angle1 (This.Void_Ptr, Interfaces.C.short (To));
+ end Set_First_Angle;
+
+
+ function Get_Second_Angle
+ (This : in Dial)
+ return Short_Integer is
+ begin
+ return Short_Integer (fl_dial_get_angle2 (This.Void_Ptr));
+ end Get_Second_Angle;
+
+
+ procedure Set_Second_Angle
+ (This : in out Dial;
+ To : in Short_Integer) is
+ begin
+ fl_dial_set_angle2 (This.Void_Ptr, Interfaces.C.short (To));
+ end Set_Second_Angle;
+
+
+ procedure Set_Angles
+ (This : in out Dial;
+ One, Two : in Short_Integer) is
+ begin
+ fl_dial_set_angles
+ (This.Void_Ptr,
+ Interfaces.C.short (One),
+ Interfaces.C.short (Two));
+ end Set_Angles;
+
+
+
+
+ procedure Draw
+ (This : in out Dial) is
+ begin
+ Valuator (This).Draw;
+ end Draw;
+
+
+ procedure Draw
+ (This : in out Dial;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_dial_draw2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Draw;
+
+
+ function Handle
+ (This : in out Dial;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Valuator (This).Handle (Event);
+ end Handle;
+
+
+ function Handle
+ (This : in out Dial;
+ Event : in Event_Kind;
+ X, Y, W, H : in Integer)
+ return Event_Outcome is
+ begin
+ return Event_Outcome'Val (fl_dial_handle2
+ (This.Void_Ptr,
+ Event_Kind'Pos (Event),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H)));
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error;
+ end Handle;
+
+
+
+
+ function Get_Kind
+ (This : in Dial)
+ return Dial_Kind
+ is
+ Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr);
+ begin
+ return Dial_Kind'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Dial::type returned unexpected unsigned char value of " &
+ Interfaces.C.unsigned_char'Image (Result);
+ end Get_Kind;
+
+
+ package body Extra is
+
+ procedure Set_Kind
+ (This : in out Dial;
+ To : in Dial_Kind) is
+ begin
+ fl_widget_set_type (This.Void_Ptr, Dial_Kind'Pos (To));
+ end Set_Kind;
+
+ pragma Inline (Set_Kind);
+
+ end Extra;
+
+
+end FLTK.Widgets.Valuators.Dials;
+
+
diff --git a/body/fltk-widgets-valuators-rollers.adb b/body/fltk-widgets-valuators-rollers.adb
new file mode 100644
index 0000000..912d374
--- /dev/null
+++ b/body/fltk-widgets-valuators-rollers.adb
@@ -0,0 +1,152 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Rollers is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_roller
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_roller, "new_fl_roller");
+ pragma Inline (new_fl_roller);
+
+ procedure free_fl_roller
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_roller, "free_fl_roller");
+ pragma Inline (free_fl_roller);
+
+
+
+
+ procedure fl_roller_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_roller_draw, "fl_roller_draw");
+ pragma Inline (fl_roller_draw);
+
+ function fl_roller_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_roller_handle, "fl_roller_handle");
+ pragma Inline (fl_roller_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Roller) is
+ begin
+ Extra_Final (Valuator (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Roller) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_roller (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Roller;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Valuator (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Roller) is
+ begin
+ This.Draw_Ptr := fl_roller_draw'Address;
+ This.Handle_Ptr := fl_roller_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Roller is
+ begin
+ return This : Roller do
+ This.Void_Ptr := new_fl_roller
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Roller is
+ begin
+ return This : Roller := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Draw
+ (This : in out Roller) is
+ begin
+ Valuator (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Roller;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Valuator (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Valuators.Rollers;
+
+
diff --git a/body/fltk-widgets-valuators-sliders-fill.adb b/body/fltk-widgets-valuators-sliders-fill.adb
new file mode 100644
index 0000000..faeef64
--- /dev/null
+++ b/body/fltk-widgets-valuators-sliders-fill.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Sliders.Fill is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_fill_slider
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_fill_slider, "new_fl_fill_slider");
+ pragma Inline (new_fl_fill_slider);
+
+ procedure free_fl_fill_slider
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_fill_slider, "free_fl_fill_slider");
+ pragma Inline (free_fl_fill_slider);
+
+
+
+
+ procedure fl_fill_slider_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_fill_slider_draw, "fl_fill_slider_draw");
+ pragma Inline (fl_fill_slider_draw);
+
+ function fl_fill_slider_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_fill_slider_handle, "fl_fill_slider_handle");
+ pragma Inline (fl_fill_slider_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Fill_Slider) is
+ begin
+ Extra_Final (Slider (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Fill_Slider) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_fill_slider (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Fill_Slider;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Slider (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Fill_Slider) is
+ begin
+ This.Draw_Ptr := fl_fill_slider_draw'Address;
+ This.Handle_Ptr := fl_fill_slider_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Fill_Slider is
+ begin
+ return This : Fill_Slider do
+ This.Void_Ptr := new_fl_fill_slider
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Fill_Slider is
+ begin
+ return This : Fill_Slider := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Valuators.Sliders.Fill;
+
+
diff --git a/body/fltk-widgets-valuators-sliders-horizontal.adb b/body/fltk-widgets-valuators-sliders-horizontal.adb
new file mode 100644
index 0000000..fdb722c
--- /dev/null
+++ b/body/fltk-widgets-valuators-sliders-horizontal.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Sliders.Horizontal is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_horizontal_slider
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_horizontal_slider, "new_fl_horizontal_slider");
+ pragma Inline (new_fl_horizontal_slider);
+
+ procedure free_fl_horizontal_slider
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_horizontal_slider, "free_fl_horizontal_slider");
+ pragma Inline (free_fl_horizontal_slider);
+
+
+
+
+ procedure fl_horizontal_slider_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_horizontal_slider_draw, "fl_horizontal_slider_draw");
+ pragma Inline (fl_horizontal_slider_draw);
+
+ function fl_horizontal_slider_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_horizontal_slider_handle, "fl_horizontal_slider_handle");
+ pragma Inline (fl_horizontal_slider_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Horizontal_Slider) is
+ begin
+ Extra_Final (Slider (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Horizontal_Slider) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_horizontal_slider (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Horizontal_Slider;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Slider (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Horizontal_Slider) is
+ begin
+ This.Draw_Ptr := fl_horizontal_slider_draw'Address;
+ This.Handle_Ptr := fl_horizontal_slider_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Horizontal_Slider is
+ begin
+ return This : Horizontal_Slider do
+ This.Void_Ptr := new_fl_horizontal_slider
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Horizontal_Slider is
+ begin
+ return This : Horizontal_Slider := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Valuators.Sliders.Horizontal;
+
+
diff --git a/body/fltk-widgets-valuators-sliders-horizontal_fill.adb b/body/fltk-widgets-valuators-sliders-horizontal_fill.adb
new file mode 100644
index 0000000..5b681a3
--- /dev/null
+++ b/body/fltk-widgets-valuators-sliders-horizontal_fill.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Sliders.Horizontal_Fill is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_hor_fill_slider
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_hor_fill_slider, "new_fl_hor_fill_slider");
+ pragma Inline (new_fl_hor_fill_slider);
+
+ procedure free_fl_hor_fill_slider
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_hor_fill_slider, "free_fl_hor_fill_slider");
+ pragma Inline (free_fl_hor_fill_slider);
+
+
+
+
+ procedure fl_hor_fill_slider_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_hor_fill_slider_draw, "fl_hor_fill_slider_draw");
+ pragma Inline (fl_hor_fill_slider_draw);
+
+ function fl_hor_fill_slider_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_hor_fill_slider_handle, "fl_hor_fill_slider_handle");
+ pragma Inline (fl_hor_fill_slider_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Horizontal_Fill_Slider) is
+ begin
+ Extra_Final (Slider (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Horizontal_Fill_Slider) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_hor_fill_slider (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Horizontal_Fill_Slider;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Slider (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Horizontal_Fill_Slider) is
+ begin
+ This.Draw_Ptr := fl_hor_fill_slider_draw'Address;
+ This.Handle_Ptr := fl_hor_fill_slider_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Horizontal_Fill_Slider is
+ begin
+ return This : Horizontal_Fill_Slider do
+ This.Void_Ptr := new_fl_hor_fill_slider
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Horizontal_Fill_Slider is
+ begin
+ return This : Horizontal_Fill_Slider := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Valuators.Sliders.Horizontal_Fill;
+
+
diff --git a/body/fltk-widgets-valuators-sliders-horizontal_nice.adb b/body/fltk-widgets-valuators-sliders-horizontal_nice.adb
new file mode 100644
index 0000000..3e3d89d
--- /dev/null
+++ b/body/fltk-widgets-valuators-sliders-horizontal_nice.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Sliders.Horizontal_Nice is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_hor_nice_slider
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_hor_nice_slider, "new_fl_hor_nice_slider");
+ pragma Inline (new_fl_hor_nice_slider);
+
+ procedure free_fl_hor_nice_slider
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_hor_nice_slider, "free_fl_hor_nice_slider");
+ pragma Inline (free_fl_hor_nice_slider);
+
+
+
+
+ procedure fl_hor_nice_slider_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_hor_nice_slider_draw, "fl_hor_nice_slider_draw");
+ pragma Inline (fl_hor_nice_slider_draw);
+
+ function fl_hor_nice_slider_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_hor_nice_slider_handle, "fl_hor_nice_slider_handle");
+ pragma Inline (fl_hor_nice_slider_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Horizontal_Nice_Slider) is
+ begin
+ Extra_Final (Slider (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Horizontal_Nice_Slider) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_hor_nice_slider (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Horizontal_Nice_Slider;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Slider (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Horizontal_Nice_Slider) is
+ begin
+ This.Draw_Ptr := fl_hor_nice_slider_draw'Address;
+ This.Handle_Ptr := fl_hor_nice_slider_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Horizontal_Nice_Slider is
+ begin
+ return This : Horizontal_Nice_Slider do
+ This.Void_Ptr := new_fl_hor_nice_slider
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Horizontal_Nice_Slider is
+ begin
+ return This : Horizontal_Nice_Slider := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Valuators.Sliders.Horizontal_Nice;
+
+
diff --git a/body/fltk-widgets-valuators-sliders-nice.adb b/body/fltk-widgets-valuators-sliders-nice.adb
new file mode 100644
index 0000000..b9bc449
--- /dev/null
+++ b/body/fltk-widgets-valuators-sliders-nice.adb
@@ -0,0 +1,129 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Sliders.Nice is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_nice_slider
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_nice_slider, "new_fl_nice_slider");
+ pragma Inline (new_fl_nice_slider);
+
+ procedure free_fl_nice_slider
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_nice_slider, "free_fl_nice_slider");
+ pragma Inline (free_fl_nice_slider);
+
+
+
+
+ procedure fl_nice_slider_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_nice_slider_draw, "fl_nice_slider_draw");
+ pragma Inline (fl_nice_slider_draw);
+
+ function fl_nice_slider_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_nice_slider_handle, "fl_nice_slider_handle");
+ pragma Inline (fl_nice_slider_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Nice_Slider) is
+ begin
+ Extra_Final (Slider (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Nice_Slider) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_nice_slider (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Nice_Slider;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Slider (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Nice_Slider) is
+ begin
+ This.Draw_Ptr := fl_nice_slider_draw'Address;
+ This.Handle_Ptr := fl_nice_slider_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Nice_Slider is
+ begin
+ return This : Nice_Slider do
+ This.Void_Ptr := new_fl_nice_slider
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Nice_Slider is
+ begin
+ return This : Nice_Slider := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Valuators.Sliders.Nice;
+
+
diff --git a/body/fltk-widgets-valuators-sliders-scrollbars.adb b/body/fltk-widgets-valuators-sliders-scrollbars.adb
new file mode 100644
index 0000000..26d9049
--- /dev/null
+++ b/body/fltk-widgets-valuators-sliders-scrollbars.adb
@@ -0,0 +1,275 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Sliders.Scrollbars is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_scrollbar
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_scrollbar, "new_fl_scrollbar");
+ pragma Inline (new_fl_scrollbar);
+
+ procedure free_fl_scrollbar
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_scrollbar, "free_fl_scrollbar");
+ pragma Inline (free_fl_scrollbar);
+
+
+
+
+ function fl_scrollbar_get_linesize
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_scrollbar_get_linesize, "fl_scrollbar_get_linesize");
+ pragma Inline (fl_scrollbar_get_linesize);
+
+ procedure fl_scrollbar_set_linesize
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_scrollbar_set_linesize, "fl_scrollbar_set_linesize");
+ pragma Inline (fl_scrollbar_set_linesize);
+
+ function fl_scrollbar_get_value
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_scrollbar_get_value, "fl_scrollbar_get_value");
+ pragma Inline (fl_scrollbar_get_value);
+
+ procedure fl_scrollbar_set_value
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_scrollbar_set_value, "fl_scrollbar_set_value");
+ pragma Inline (fl_scrollbar_set_value);
+
+ procedure fl_scrollbar_set_value2
+ (S : in Storage.Integer_Address;
+ P, W, F, T : in Interfaces.C.int);
+ pragma Import (C, fl_scrollbar_set_value2, "fl_scrollbar_set_value2");
+ pragma Inline (fl_scrollbar_set_value2);
+
+
+
+
+ procedure fl_scrollbar_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_scrollbar_draw, "fl_scrollbar_draw");
+ pragma Inline (fl_scrollbar_draw);
+
+ function fl_scrollbar_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_scrollbar_handle, "fl_scrollbar_handle");
+ pragma Inline (fl_scrollbar_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ -- End of the line
+ procedure scrollbar_extra_final_hook
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Export (C, scrollbar_extra_final_hook, "scrollbar_extra_final_hook");
+
+ procedure scrollbar_extra_final_hook
+ (Ada_Obj : in Storage.Integer_Address)
+ is
+ My_Scrollbar : Scrollbar;
+ for My_Scrollbar'Address use Storage.To_Address (Ada_Obj);
+ pragma Import (Ada, My_Scrollbar);
+ begin
+ Extra_Final (My_Scrollbar);
+ end scrollbar_extra_final_hook;
+
+
+ procedure Extra_Final
+ (This : in out Scrollbar) is
+ begin
+ Extra_Final (Slider (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Scrollbar) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_scrollbar (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ -- Radio signal successfully intercepted
+ procedure scrollbar_extra_init_hook
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.Strings.chars_ptr);
+ pragma Export (C, scrollbar_extra_init_hook, "scrollbar_extra_init_hook");
+
+ procedure scrollbar_extra_init_hook
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.Strings.chars_ptr)
+ is
+ My_Scrollbar : Scrollbar;
+ for My_Scrollbar'Address use Storage.To_Address (Ada_Obj);
+ pragma Import (Ada, My_Scrollbar);
+ begin
+ Extra_Init
+ (My_Scrollbar,
+ Integer (X), Integer (Y),
+ Integer (W), Integer (H),
+ Interfaces.C.Strings.Value (C_Str));
+ end scrollbar_extra_init_hook;
+
+
+ procedure Extra_Init
+ (This : in out Scrollbar;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Slider (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Scrollbar) is
+ begin
+ This.Draw_Ptr := fl_scrollbar_draw'Address;
+ This.Handle_Ptr := fl_scrollbar_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Scrollbar is
+ begin
+ return This : Scrollbar do
+ This.Void_Ptr := new_fl_scrollbar
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Scrollbar is
+ begin
+ return This : Scrollbar := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Line_Size
+ (This : in Scrollbar)
+ return Natural is
+ begin
+ return Natural (fl_scrollbar_get_linesize (This.Void_Ptr));
+ end Get_Line_Size;
+
+
+ procedure Set_Line_Size
+ (This : in out Scrollbar;
+ To : in Natural) is
+ begin
+ fl_scrollbar_set_linesize (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Line_Size;
+
+
+ function Get_Position
+ (This : in Scrollbar)
+ return Natural is
+ begin
+ return Natural (fl_scrollbar_get_value (This.Void_Ptr));
+ end Get_Position;
+
+
+ procedure Set_Position
+ (This : in out Scrollbar;
+ To : in Natural) is
+ begin
+ fl_scrollbar_set_value (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Position;
+
+
+ procedure Set_All
+ (This : in out Scrollbar;
+ Position : in Natural;
+ Win_Size : in Natural;
+ First_Line : in Natural;
+ Total_Lines : in Natural) is
+ begin
+ fl_scrollbar_set_value2
+ (This.Void_Ptr,
+ Interfaces.C.int (Position),
+ Interfaces.C.int (Win_Size),
+ Interfaces.C.int (First_Line),
+ Interfaces.C.int (Total_Lines));
+ end Set_All;
+
+
+
+
+ procedure Draw
+ (This : in out Scrollbar) is
+ begin
+ Slider (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Scrollbar;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Slider (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Valuators.Sliders.Scrollbars;
+
+
diff --git a/body/fltk-widgets-valuators-sliders-value-horizontal.adb b/body/fltk-widgets-valuators-sliders-value-horizontal.adb
new file mode 100644
index 0000000..fd91800
--- /dev/null
+++ b/body/fltk-widgets-valuators-sliders-value-horizontal.adb
@@ -0,0 +1,130 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_hor_value_slider
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_hor_value_slider, "new_fl_hor_value_slider");
+ pragma Inline (new_fl_hor_value_slider);
+
+ procedure free_fl_hor_value_slider
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_hor_value_slider, "free_fl_hor_value_slider");
+ pragma Inline (free_fl_hor_value_slider);
+
+
+
+
+ procedure fl_hor_value_slider_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_hor_value_slider_draw, "fl_hor_value_slider_draw");
+ pragma Inline (fl_hor_value_slider_draw);
+
+ function fl_hor_value_slider_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_hor_value_slider_handle, "fl_hor_value_slider_handle");
+ pragma Inline (fl_hor_value_slider_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Horizontal_Value_Slider) is
+ begin
+ Extra_Final (Value_Slider (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Horizontal_Value_Slider) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_hor_value_slider (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Horizontal_Value_Slider;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Value_Slider (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Horizontal_Value_Slider) is
+ begin
+ This.Draw_Ptr := fl_hor_value_slider_draw'Address;
+ This.Handle_Ptr := fl_hor_value_slider_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Horizontal_Value_Slider is
+ begin
+ return This : Horizontal_Value_Slider do
+ This.Void_Ptr := new_fl_hor_value_slider
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Horizontal_Value_Slider is
+ begin
+ return This : Horizontal_Value_Slider := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+end FLTK.Widgets.Valuators.Sliders.Value.Horizontal;
+
+
diff --git a/body/fltk-widgets-valuators-sliders-value.adb b/body/fltk-widgets-valuators-sliders-value.adb
new file mode 100644
index 0000000..9d32529
--- /dev/null
+++ b/body/fltk-widgets-valuators-sliders-value.adb
@@ -0,0 +1,241 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Sliders.Value is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_value_slider
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_value_slider, "new_fl_value_slider");
+ pragma Inline (new_fl_value_slider);
+
+ procedure free_fl_value_slider
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_value_slider, "free_fl_value_slider");
+ pragma Inline (free_fl_value_slider);
+
+
+
+
+ function fl_value_slider_get_textcolor
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_value_slider_get_textcolor, "fl_value_slider_get_textcolor");
+ pragma Inline (fl_value_slider_get_textcolor);
+
+ procedure fl_value_slider_set_textcolor
+ (S : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_value_slider_set_textcolor, "fl_value_slider_set_textcolor");
+ pragma Inline (fl_value_slider_set_textcolor);
+
+ function fl_value_slider_get_textfont
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_slider_get_textfont, "fl_value_slider_get_textfont");
+ pragma Inline (fl_value_slider_get_textfont);
+
+ procedure fl_value_slider_set_textfont
+ (S : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_value_slider_set_textfont, "fl_value_slider_set_textfont");
+ pragma Inline (fl_value_slider_set_textfont);
+
+ function fl_value_slider_get_textsize
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_slider_get_textsize, "fl_value_slider_get_textsize");
+ pragma Inline (fl_value_slider_get_textsize);
+
+ procedure fl_value_slider_set_textsize
+ (S : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_value_slider_set_textsize, "fl_value_slider_set_textsize");
+ pragma Inline (fl_value_slider_set_textsize);
+
+
+
+
+ procedure fl_value_slider_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_value_slider_draw, "fl_value_slider_draw");
+ pragma Inline (fl_value_slider_draw);
+
+ function fl_value_slider_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_slider_handle, "fl_value_slider_handle");
+ pragma Inline (fl_value_slider_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Value_Slider) is
+ begin
+ Extra_Final (Slider (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Value_Slider) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_value_slider (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Value_Slider;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Slider (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Value_Slider) is
+ begin
+ This.Draw_Ptr := fl_value_slider_draw'Address;
+ This.Handle_Ptr := fl_value_slider_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Value_Slider is
+ begin
+ return This : Value_Slider do
+ This.Void_Ptr := new_fl_value_slider
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Value_Slider is
+ begin
+ return This : Value_Slider := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Text_Color
+ (This : in Value_Slider)
+ return Color is
+ begin
+ return Color (fl_value_slider_get_textcolor (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Value_Slider;
+ To : in Color) is
+ begin
+ fl_value_slider_set_textcolor (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Value_Slider)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_value_slider_get_textfont (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Value_Slider;
+ To : in Font_Kind) is
+ begin
+ fl_value_slider_set_textfont (This.Void_Ptr, Font_Kind'Pos (To));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Value_Slider)
+ return Font_Size is
+ begin
+ return Font_Size (fl_value_slider_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Value_Slider;
+ To : in Font_Size) is
+ begin
+ fl_value_slider_set_textsize (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Text_Size;
+
+
+
+
+ procedure Draw
+ (This : in out Value_Slider) is
+ begin
+ Slider (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Value_Slider;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Slider (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Valuators.Sliders.Value;
+
+
diff --git a/body/fltk-widgets-valuators-sliders.adb b/body/fltk-widgets-valuators-sliders.adb
new file mode 100644
index 0000000..b81729f
--- /dev/null
+++ b/body/fltk-widgets-valuators-sliders.adb
@@ -0,0 +1,382 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+
+package body FLTK.Widgets.Valuators.Sliders is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_slider
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_slider, "new_fl_slider");
+ pragma Inline (new_fl_slider);
+
+ function new_fl_slider2
+ (K : in Interfaces.C.unsigned_char;
+ X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_slider2, "new_fl_slider2");
+ pragma Inline (new_fl_slider2);
+
+ procedure free_fl_slider
+ (D : in Storage.Integer_Address);
+ pragma Import (C, free_fl_slider, "free_fl_slider");
+ pragma Inline (free_fl_slider);
+
+
+
+
+ procedure fl_slider_set_bounds
+ (S : in Storage.Integer_Address;
+ A, B : in Interfaces.C.double);
+ pragma Import (C, fl_slider_set_bounds, "fl_slider_set_bounds");
+ pragma Inline (fl_slider_set_bounds);
+
+ function fl_slider_get_slider
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_slider_get_slider, "fl_slider_get_slider");
+ pragma Inline (fl_slider_get_slider);
+
+ procedure fl_slider_set_slider
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_slider_set_slider, "fl_slider_set_slider");
+ pragma Inline (fl_slider_set_slider);
+
+ function fl_slider_get_slider_size
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.C_float;
+ pragma Import (C, fl_slider_get_slider_size, "fl_slider_get_slider_size");
+ pragma Inline (fl_slider_get_slider_size);
+
+ procedure fl_slider_set_slider_size
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.double);
+ pragma Import (C, fl_slider_set_slider_size, "fl_slider_set_slider_size");
+ pragma Inline (fl_slider_set_slider_size);
+
+ function fl_slider_scrollvalue
+ (S : in Storage.Integer_Address;
+ P, Z, F, T : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_slider_scrollvalue, "fl_slider_scrollvalue");
+ pragma Inline (fl_slider_scrollvalue);
+
+
+
+
+ procedure fl_slider_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_slider_draw, "fl_slider_draw");
+ pragma Inline (fl_slider_draw);
+
+ procedure fl_slider_draw2
+ (S : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_slider_draw2, "fl_slider_draw2");
+ pragma Inline (fl_slider_draw2);
+
+ function fl_slider_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_slider_handle, "fl_slider_handle");
+ pragma Inline (fl_slider_handle);
+
+ function fl_slider_handle2
+ (S : in Storage.Integer_Address;
+ E, X, Y, W, H : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_slider_handle2, "fl_slider_handle2");
+ pragma Inline (fl_slider_handle2);
+
+
+
+
+ function fl_widget_get_type
+ (S : in Storage.Integer_Address)
+ return Interfaces.C.unsigned_char;
+ pragma Import (C, fl_widget_get_type, "fl_widget_get_type");
+ pragma Inline (fl_widget_get_type);
+
+ procedure fl_widget_set_type
+ (S : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned_char);
+ pragma Import (C, fl_widget_set_type, "fl_widget_set_type");
+ pragma Inline (fl_widget_set_type);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Slider) is
+ begin
+ Extra_Final (Valuator (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Slider) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_slider (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Slider;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Valuator (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Slider) is
+ begin
+ This.Draw_Ptr := fl_slider_draw'Address;
+ This.Handle_Ptr := fl_slider_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Slider is
+ begin
+ return This : Slider do
+ This.Void_Ptr := new_fl_slider
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Slider is
+ begin
+ return This : Slider := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+
+ function Create
+ (Kind : in Slider_Kind;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Slider is
+ begin
+ return This : Slider do
+ This.Void_Ptr := new_fl_slider2
+ (Slider_Kind'Pos (Kind),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ Kind : in Slider_Kind;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Slider is
+ begin
+ return This : Slider := Create (Kind, X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Set_Bounds
+ (This : in out Slider;
+ Min, Max : in Long_Float) is
+ begin
+ fl_slider_set_bounds
+ (This.Void_Ptr,
+ Interfaces.C.double (Min),
+ Interfaces.C.double (Max));
+ end Set_Bounds;
+
+
+ function Get_Box
+ (This : in Slider)
+ return Box_Kind is
+ begin
+ return Box_Kind'Val (fl_slider_get_slider (This.Void_Ptr));
+ end Get_Box;
+
+
+ procedure Set_Box
+ (This : in out Slider;
+ To : in Box_Kind) is
+ begin
+ fl_slider_set_slider (This.Void_Ptr, Box_Kind'Pos (To));
+ end Set_Box;
+
+
+ function Get_Slide_Size
+ (This : in Slider)
+ return Float is
+ begin
+ return Float (fl_slider_get_slider_size (This.Void_Ptr));
+ end Get_Slide_Size;
+
+
+ procedure Set_Slide_Size
+ (This : in out Slider;
+ To : in Long_Float) is
+ begin
+ fl_slider_set_slider_size (This.Void_Ptr, Interfaces.C.double (To));
+ end Set_Slide_Size;
+
+
+ procedure Set_Scrollvalue
+ (This : in out Slider;
+ Pos_First_Line : in Natural;
+ Lines_In_Window : in Natural;
+ First_Line_Num : in Natural;
+ Total_Lines : in Natural)
+ is
+ Ignore_Me : Interfaces.C.int;
+ begin
+ Ignore_Me := fl_slider_scrollvalue
+ (This.Void_Ptr,
+ Interfaces.C.int (Pos_First_Line),
+ Interfaces.C.int (Lines_In_Window),
+ Interfaces.C.int (First_Line_Num),
+ Interfaces.C.int (Total_Lines));
+ end Set_Scrollvalue;
+
+
+
+
+ procedure Draw
+ (This : in out Slider) is
+ begin
+ Valuator (This).Draw;
+ end Draw;
+
+
+ procedure Draw
+ (This : in out Slider;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_slider_draw2
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Draw;
+
+
+ function Handle
+ (This : in out Slider;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Valuator (This).Handle (Event);
+ end Handle;
+
+
+ function Handle
+ (This : in out Slider;
+ Event : in Event_Kind;
+ X, Y, W, H : in Integer)
+ return Event_Outcome is
+ begin
+ return Event_Outcome'Val (fl_slider_handle2
+ (This.Void_Ptr,
+ Event_Kind'Pos (Event),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H)));
+ end Handle;
+
+
+
+
+ function Get_Kind
+ (This : in Slider)
+ return Slider_Kind
+ is
+ Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr);
+ begin
+ return Slider_Kind'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Slider::type returned unexpected unsigned char value of " &
+ Interfaces.C.unsigned_char'Image (Result);
+ end Get_Kind;
+
+
+ package body Extra is
+
+ procedure Set_Kind
+ (This : in out Slider;
+ To : in Slider_Kind) is
+ begin
+ fl_widget_set_type (This.Void_Ptr, Slider_Kind'Pos (To));
+ end Set_Kind;
+
+ pragma Inline (Set_Kind);
+
+ end Extra;
+
+
+end FLTK.Widgets.Valuators.Sliders;
+
+
diff --git a/body/fltk-widgets-valuators-value_inputs.adb b/body/fltk-widgets-valuators-value_inputs.adb
new file mode 100644
index 0000000..6091d55
--- /dev/null
+++ b/body/fltk-widgets-valuators-value_inputs.adb
@@ -0,0 +1,417 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Valuators.Value_Inputs is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_value_input
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_value_input, "new_fl_value_input");
+ pragma Inline (new_fl_value_input);
+
+ procedure free_fl_value_input
+ (A : in Storage.Integer_Address);
+ pragma Import (C, free_fl_value_input, "free_fl_value_input");
+ pragma Inline (free_fl_value_input);
+
+
+
+
+ function fl_value_input_get_input
+ (V : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_value_input_get_input, "fl_value_input_get_input");
+ pragma Inline (fl_value_input_get_input);
+
+
+
+
+ function fl_value_input_get_cursor_color
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_value_input_get_cursor_color, "fl_value_input_get_cursor_color");
+ pragma Inline (fl_value_input_get_cursor_color);
+
+ procedure fl_value_input_set_cursor_color
+ (TD : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_value_input_set_cursor_color, "fl_value_input_set_cursor_color");
+ pragma Inline (fl_value_input_set_cursor_color);
+
+
+
+
+ function fl_value_input_get_shortcut
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_input_get_shortcut, "fl_value_input_get_shortcut");
+ pragma Inline (fl_value_input_get_shortcut);
+
+ procedure fl_value_input_set_shortcut
+ (B : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_value_input_set_shortcut, "fl_value_input_set_shortcut");
+ pragma Inline (fl_value_input_set_shortcut);
+
+
+
+
+ function fl_value_input_is_soft
+ (A : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_input_is_soft, "fl_value_input_is_soft");
+ pragma Inline (fl_value_input_is_soft);
+
+ procedure fl_value_input_set_soft
+ (A : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_value_input_set_soft, "fl_value_input_set_soft");
+ pragma Inline (fl_value_input_set_soft);
+
+
+
+
+ function fl_value_input_get_text_color
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_value_input_get_text_color, "fl_value_input_get_text_color");
+ pragma Inline (fl_value_input_get_text_color);
+
+ procedure fl_value_input_set_text_color
+ (TD : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_value_input_set_text_color, "fl_value_input_set_text_color");
+ pragma Inline (fl_value_input_set_text_color);
+
+ function fl_value_input_get_text_font
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_input_get_text_font, "fl_value_input_get_text_font");
+ pragma Inline (fl_value_input_get_text_font);
+
+ procedure fl_value_input_set_text_font
+ (TD : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_value_input_set_text_font, "fl_value_input_set_text_font");
+ pragma Inline (fl_value_input_set_text_font);
+
+ function fl_value_input_get_text_size
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_input_get_text_size, "fl_value_input_get_text_size");
+ pragma Inline (fl_value_input_get_text_size);
+
+ procedure fl_value_input_set_text_size
+ (TD : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_value_input_set_text_size, "fl_value_input_set_text_size");
+ pragma Inline (fl_value_input_set_text_size);
+
+
+
+
+ procedure fl_value_input_resize
+ (TD : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_value_input_resize, "fl_value_input_resize");
+ pragma Inline (fl_value_input_resize);
+
+
+
+
+ procedure fl_value_input_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_value_input_draw, "fl_value_input_draw");
+ pragma Inline (fl_value_input_draw);
+
+ function fl_value_input_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_input_handle, "fl_value_input_handle");
+ pragma Inline (fl_value_input_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ -- Making a long distance telephone call
+ procedure fl_text_input_extra_final
+ (Ada_Obj : in Storage.Integer_Address);
+ pragma Import (C, fl_text_input_extra_final, "fl_text_input_extra_final");
+ pragma Inline (fl_text_input_extra_final);
+
+
+ procedure Extra_Final
+ (This : in out Value_Input) is
+ begin
+ fl_text_input_extra_final (Storage.To_Integer (This.My_Input'Address));
+ Extra_Final (Valuator (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Value_Input) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_value_input (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ -- Black magic, don't try this at home kids
+ procedure fl_text_input_extra_init
+ (Ada_Obj : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int;
+ C_Str : in Interfaces.C.char_array);
+ pragma Import (C, fl_text_input_extra_init, "fl_text_input_extra_init");
+ pragma Inline (fl_text_input_extra_init);
+
+
+ procedure Extra_Init
+ (This : in out Value_Input;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Wrapper (This.My_Input).Void_Ptr := fl_value_input_get_input (This.Void_Ptr);
+ Wrapper (This.My_Input).Needs_Dealloc := False;
+ fl_text_input_extra_init
+ (Storage.To_Integer (This.My_Input'Address),
+ Interfaces.C.int (This.My_Input.Get_X),
+ Interfaces.C.int (This.My_Input.Get_Y),
+ Interfaces.C.int (This.My_Input.Get_W),
+ Interfaces.C.int (This.My_Input.Get_H),
+ Interfaces.C.To_C (This.My_Input.Get_Label));
+ Extra_Init (Valuator (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Value_Input) is
+ begin
+ This.Draw_Ptr := fl_value_input_draw'Address;
+ This.Handle_Ptr := fl_value_input_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Value_Input is
+ begin
+ return This : Value_Input do
+ This.Void_Ptr := new_fl_value_input
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Value_Input is
+ begin
+ return This : Value_Input := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ ------------------
+ -- Attributes --
+ ------------------
+
+ function Text_Field
+ (This : in out Value_Input)
+ return FLTK.Widgets.Inputs.Text.Text_Input_Reference is
+ begin
+ return (Data => This.My_Input'Unchecked_Access);
+ end Text_Field;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Get_Cursor_Color
+ (This : in Value_Input)
+ return Color is
+ begin
+ return Color (fl_value_input_get_cursor_color (This.Void_Ptr));
+ end Get_Cursor_Color;
+
+
+ procedure Set_Cursor_Color
+ (This : in out Value_Input;
+ Col : in Color) is
+ begin
+ fl_value_input_set_cursor_color (This.Void_Ptr, Interfaces.C.unsigned (Col));
+ end Set_Cursor_Color;
+
+
+
+
+ function Get_Shortcut
+ (This : in Value_Input)
+ return Key_Combo is
+ begin
+ return To_Ada (fl_value_input_get_shortcut (This.Void_Ptr));
+ end Get_Shortcut;
+
+
+ procedure Set_Shortcut
+ (This : in out Value_Input;
+ Key : in Key_Combo) is
+ begin
+ fl_value_input_set_shortcut (This.Void_Ptr, Interfaces.C.int (To_C (Key)));
+ end Set_Shortcut;
+
+
+
+
+ function Is_Soft
+ (This : in Value_Input)
+ return Boolean is
+ begin
+ return fl_value_input_is_soft (This.Void_Ptr) /= 0;
+ end Is_Soft;
+
+
+ procedure Set_Soft
+ (This : in out Value_Input;
+ To : in Boolean) is
+ begin
+ fl_value_input_set_soft (This.Void_Ptr, Boolean'Pos (To));
+ end Set_Soft;
+
+
+
+
+ function Get_Text_Color
+ (This : in Value_Input)
+ return Color is
+ begin
+ return Color (fl_value_input_get_text_color (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Value_Input;
+ Col : in Color) is
+ begin
+ fl_value_input_set_text_color (This.Void_Ptr, Interfaces.C.unsigned (Col));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Value_Input)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_value_input_get_text_font (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Value_Input;
+ Font : in Font_Kind) is
+ begin
+ fl_value_input_set_text_font (This.Void_Ptr, Font_Kind'Pos (Font));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Value_Input)
+ return Font_Size is
+ begin
+ return Font_Size (fl_value_input_get_text_size (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Value_Input;
+ Size : in Font_Size) is
+ begin
+ fl_value_input_set_text_size (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Text_Size;
+
+
+
+
+ procedure Resize
+ (This : in out Value_Input;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_value_input_resize
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Resize;
+
+
+
+
+ procedure Draw
+ (This : in out Value_Input) is
+ begin
+ Valuator (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Value_Input;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Valuator (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Valuators.Value_Inputs;
+
+
diff --git a/body/fltk-widgets-valuators-value_outputs.adb b/body/fltk-widgets-valuators-value_outputs.adb
new file mode 100644
index 0000000..935e021
--- /dev/null
+++ b/body/fltk-widgets-valuators-value_outputs.adb
@@ -0,0 +1,278 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Valuators.Value_Outputs is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_value_output
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_value_output, "new_fl_value_output");
+ pragma Inline (new_fl_value_output);
+
+ procedure free_fl_value_output
+ (A : in Storage.Integer_Address);
+ pragma Import (C, free_fl_value_output, "free_fl_value_output");
+ pragma Inline (free_fl_value_output);
+
+
+
+
+ function fl_value_output_is_soft
+ (A : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_output_is_soft, "fl_value_output_is_soft");
+ pragma Inline (fl_value_output_is_soft);
+
+ procedure fl_value_output_set_soft
+ (A : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_value_output_set_soft, "fl_value_output_set_soft");
+ pragma Inline (fl_value_output_set_soft);
+
+
+
+
+ function fl_value_output_get_text_color
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_value_output_get_text_color, "fl_value_output_get_text_color");
+ pragma Inline (fl_value_output_get_text_color);
+
+ procedure fl_value_output_set_text_color
+ (TD : in Storage.Integer_Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_value_output_set_text_color, "fl_value_output_set_text_color");
+ pragma Inline (fl_value_output_set_text_color);
+
+ function fl_value_output_get_text_font
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_output_get_text_font, "fl_value_output_get_text_font");
+ pragma Inline (fl_value_output_get_text_font);
+
+ procedure fl_value_output_set_text_font
+ (TD : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_value_output_set_text_font, "fl_value_output_set_text_font");
+ pragma Inline (fl_value_output_set_text_font);
+
+ function fl_value_output_get_text_size
+ (TD : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_output_get_text_size, "fl_value_output_get_text_size");
+ pragma Inline (fl_value_output_get_text_size);
+
+ procedure fl_value_output_set_text_size
+ (TD : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_value_output_set_text_size, "fl_value_output_set_text_size");
+ pragma Inline (fl_value_output_set_text_size);
+
+
+
+
+ procedure fl_value_output_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_value_output_draw, "fl_value_output_draw");
+ pragma Inline (fl_value_output_draw);
+
+ function fl_value_output_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_value_output_handle, "fl_value_output_handle");
+ pragma Inline (fl_value_output_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Value_Output) is
+ begin
+ Extra_Final (Valuator (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Value_Output) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_value_output (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Value_Output;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Valuator (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Value_Output) is
+ begin
+ This.Draw_Ptr := fl_value_output_draw'Address;
+ This.Handle_Ptr := fl_value_output_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Value_Output is
+ begin
+ return This : Value_Output do
+ This.Void_Ptr := new_fl_value_output
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Value_Output is
+ begin
+ return This : Value_Output := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Is_Soft
+ (This : in Value_Output)
+ return Boolean is
+ begin
+ return fl_value_output_is_soft (This.Void_Ptr) /= 0;
+ end Is_Soft;
+
+
+ procedure Set_Soft
+ (This : in out Value_Output;
+ To : in Boolean) is
+ begin
+ fl_value_output_set_soft (This.Void_Ptr, Boolean'Pos (To));
+ end Set_Soft;
+
+
+
+
+ function Get_Text_Color
+ (This : in Value_Output)
+ return Color is
+ begin
+ return Color (fl_value_output_get_text_color (This.Void_Ptr));
+ end Get_Text_Color;
+
+
+ procedure Set_Text_Color
+ (This : in out Value_Output;
+ Col : in Color) is
+ begin
+ fl_value_output_set_text_color (This.Void_Ptr, Interfaces.C.unsigned (Col));
+ end Set_Text_Color;
+
+
+ function Get_Text_Font
+ (This : in Value_Output)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_value_output_get_text_font (This.Void_Ptr));
+ end Get_Text_Font;
+
+
+ procedure Set_Text_Font
+ (This : in out Value_Output;
+ Font : in Font_Kind) is
+ begin
+ fl_value_output_set_text_font (This.Void_Ptr, Font_Kind'Pos (Font));
+ end Set_Text_Font;
+
+
+ function Get_Text_Size
+ (This : in Value_Output)
+ return Font_Size is
+ begin
+ return Font_Size (fl_value_output_get_text_size (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Value_Output;
+ Size : in Font_Size) is
+ begin
+ fl_value_output_set_text_size (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Text_Size;
+
+
+
+
+ procedure Draw
+ (This : in out Value_Output) is
+ begin
+ Valuator (This).Draw;
+ end Draw;
+
+
+ function Handle
+ (This : in out Value_Output;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Valuator (This).Handle (Event);
+ end Handle;
+
+
+end FLTK.Widgets.Valuators.Value_Outputs;
+
+
diff --git a/body/fltk-widgets-valuators.adb b/body/fltk-widgets-valuators.adb
new file mode 100644
index 0000000..0cf8d65
--- /dev/null
+++ b/body/fltk-widgets-valuators.adb
@@ -0,0 +1,482 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ FLTK.Widgets.Groups,
+ Interfaces.C.Strings,
+ System.Address_To_Access_Conversions;
+
+
+package body FLTK.Widgets.Valuators is
+
+
+ package Chk renames Ada.Assertions;
+
+ package Valuator_Convert is new System.Address_To_Access_Conversions (Valuator'Class);
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_valuator
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_valuator, "new_fl_valuator");
+ pragma Inline (new_fl_valuator);
+
+ procedure free_fl_valuator
+ (V : in Storage.Integer_Address);
+ pragma Import (C, free_fl_valuator, "free_fl_valuator");
+ pragma Inline (free_fl_valuator);
+
+
+
+
+ function fl_valuator_format
+ (V : in Storage.Integer_Address;
+ B : out Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_valuator_format, "fl_valuator_format");
+ pragma Inline (fl_valuator_format);
+
+
+
+
+ function fl_valuator_clamp
+ (V : in Storage.Integer_Address;
+ D : in Interfaces.C.double)
+ return Interfaces.C.double;
+ pragma Import (C, fl_valuator_clamp, "fl_valuator_clamp");
+ pragma Inline (fl_valuator_clamp);
+
+ function fl_valuator_round
+ (V : in Storage.Integer_Address;
+ D : in Interfaces.C.double)
+ return Interfaces.C.double;
+ pragma Import (C, fl_valuator_round, "fl_valuator_round");
+ pragma Inline (fl_valuator_round);
+
+ function fl_valuator_increment
+ (V : in Storage.Integer_Address;
+ D : in Interfaces.C.double;
+ S : in Interfaces.C.int)
+ return Interfaces.C.double;
+ pragma Import (C, fl_valuator_increment, "fl_valuator_increment");
+ pragma Inline (fl_valuator_increment);
+
+
+
+
+ function fl_valuator_get_minimum
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_valuator_get_minimum, "fl_valuator_get_minimum");
+ pragma Inline (fl_valuator_get_minimum);
+
+ procedure fl_valuator_set_minimum
+ (V : in Storage.Integer_Address;
+ D : in Interfaces.C.double);
+ pragma Import (C, fl_valuator_set_minimum, "fl_valuator_set_minimum");
+ pragma Inline (fl_valuator_set_minimum);
+
+ function fl_valuator_get_maximum
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_valuator_get_maximum, "fl_valuator_get_maximum");
+ pragma Inline (fl_valuator_get_maximum);
+
+ procedure fl_valuator_set_maximum
+ (V : in Storage.Integer_Address;
+ D : in Interfaces.C.double);
+ pragma Import (C, fl_valuator_set_maximum, "fl_valuator_set_maximum");
+ pragma Inline (fl_valuator_set_maximum);
+
+ function fl_valuator_get_step
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_valuator_get_step, "fl_valuator_get_step");
+ pragma Inline (fl_valuator_get_step);
+
+ procedure fl_valuator_set_step_top
+ (V : in Storage.Integer_Address;
+ T : in Interfaces.C.double);
+ pragma Import (C, fl_valuator_set_step_top, "fl_valuator_set_step_top");
+ pragma Inline (fl_valuator_set_step_top);
+
+ procedure fl_valuator_set_step_bottom
+ (V : in Storage.Integer_Address;
+ B : in Interfaces.C.int);
+ pragma Import (C, fl_valuator_set_step_bottom, "fl_valuator_set_step_bottom");
+ pragma Inline (fl_valuator_set_step_bottom);
+
+ procedure fl_valuator_set_step
+ (V : in Storage.Integer_Address;
+ T : in Interfaces.C.double;
+ B : in Interfaces.C.int);
+ pragma Import (C, fl_valuator_set_step, "fl_valuator_set_step");
+ pragma Inline (fl_valuator_set_step);
+
+ function fl_valuator_get_value
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.double;
+ pragma Import (C, fl_valuator_get_value, "fl_valuator_get_value");
+ pragma Inline (fl_valuator_get_value);
+
+ procedure fl_valuator_set_value
+ (V : in Storage.Integer_Address;
+ D : in Interfaces.C.double);
+ pragma Import (C, fl_valuator_set_value, "fl_valuator_set_value");
+ pragma Inline (fl_valuator_set_value);
+
+ procedure fl_valuator_bounds
+ (V : in Storage.Integer_Address;
+ A, B : in Interfaces.C.double);
+ pragma Import (C, fl_valuator_bounds, "fl_valuator_bounds");
+ pragma Inline (fl_valuator_bounds);
+
+ procedure fl_valuator_precision
+ (V : in Storage.Integer_Address;
+ D : in Interfaces.C.int);
+ pragma Import (C, fl_valuator_precision, "fl_valuator_precision");
+ pragma Inline (fl_valuator_precision);
+
+ procedure fl_valuator_range
+ (V : in Storage.Integer_Address;
+ A, B : in Interfaces.C.double);
+ pragma Import (C, fl_valuator_range, "fl_valuator_range");
+ pragma Inline (fl_valuator_range);
+
+
+
+
+ procedure fl_valuator_value_damage
+ (V : in Storage.Integer_Address);
+ pragma Import (C, fl_valuator_value_damage, "fl_valuator_value_damage");
+ pragma Inline (fl_valuator_value_damage);
+
+ procedure fl_valuator_draw
+ (V : in Storage.Integer_Address);
+ pragma Import (C, fl_valuator_draw, "fl_valuator_draw");
+ pragma Inline (fl_valuator_draw);
+
+ function fl_valuator_handle
+ (V : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_valuator_handle, "fl_valuator_handle");
+ pragma Inline (fl_valuator_handle);
+
+
+
+
+ ----------------------
+ -- Callback Hooks --
+ ----------------------
+
+ function Valuator_Format_Hook
+ (Userdata : in Storage.Integer_Address;
+ Buffer : in Interfaces.C.Strings.chars_ptr)
+ return Interfaces.C.int;
+ pragma Export (C, Valuator_Format_Hook, "valuator_format_hook");
+
+ function Valuator_Format_Hook
+ (Userdata : in Storage.Integer_Address;
+ Buffer : in Interfaces.C.Strings.chars_ptr)
+ return Interfaces.C.int
+ is
+ Ada_Obj : access Valuator'Class;
+ begin
+ pragma Assert (Userdata /= Null_Pointer);
+ Ada_Obj := Valuator_Convert.To_Pointer (Storage.To_Address (Userdata));
+ declare
+ -- God this whole Format method is sketchy as hell.
+ -- ...what? This is the area to declare things and that needed declaring.
+ String_Result : String := Ada_Obj.Format;
+ begin
+ if String_Result'Length <= FLTK.Buffer_Size then
+ Interfaces.C.Strings.Update (Buffer, 0, Interfaces.C.To_C (String_Result), False);
+ return String_Result'Length;
+ else
+ Interfaces.C.Strings.Update
+ (Buffer, 0, Interfaces.C.To_C (String_Result (1 .. Buffer_Size)), False);
+ return Interfaces.C.int (FLTK.Buffer_Size);
+ end if;
+ end;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error with
+ "Valuator::format callback hook was passed null userdata wrapper reference pointer";
+ end Valuator_Format_Hook;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Valuator) is
+ begin
+ Extra_Final (Widget (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Valuator) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_valuator (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Valuator;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Widget (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Valuator) is
+ begin
+ This.Draw_Ptr := fl_valuator_draw'Address;
+ This.Handle_Ptr := fl_valuator_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Valuator is
+ begin
+ return This : Valuator do
+ This.Void_Ptr := new_fl_valuator
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Valuator is
+ begin
+ return This : Valuator := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ function Format
+ (This : in Valuator)
+ return String
+ is
+ Buffer : Interfaces.C.char_array :=
+ (1 .. Interfaces.C.size_t (FLTK.Buffer_Size) => Interfaces.C.To_C (Character'Val (0)));
+ Result : Interfaces.C.int := fl_valuator_format (This.Void_Ptr, Buffer);
+ begin
+ return Interfaces.C.To_Ada (Buffer (1 .. Interfaces.C.size_t (Result)), False);
+ end Format;
+
+
+
+
+ function Clamp
+ (This : in Valuator;
+ Input : in Long_Float)
+ return Long_Float is
+ begin
+ return Long_Float (fl_valuator_clamp (This.Void_Ptr, Interfaces.C.double (Input)));
+ end Clamp;
+
+
+ function Round
+ (This : in Valuator;
+ Input : in Long_Float)
+ return Long_Float is
+ begin
+ return Long_Float (fl_valuator_round (This.Void_Ptr, Interfaces.C.double (Input)));
+ end Round;
+
+
+ function Increment
+ (This : in Valuator;
+ Input : in Long_Float;
+ Step : in Integer)
+ return Long_Float is
+ begin
+ return Long_Float (fl_valuator_increment
+ (This.Void_Ptr,
+ Interfaces.C.double (Input),
+ Interfaces.C.int (Step)));
+ end Increment;
+
+
+
+
+ function Get_Minimum
+ (This : in Valuator)
+ return Long_Float is
+ begin
+ return Long_Float (fl_valuator_get_minimum (This.Void_Ptr));
+ end Get_Minimum;
+
+
+ procedure Set_Minimum
+ (This : in out Valuator;
+ To : in Long_Float) is
+ begin
+ fl_valuator_set_minimum (This.Void_Ptr, Interfaces.C.double (To));
+ end Set_Minimum;
+
+
+ function Get_Maximum
+ (This : in Valuator)
+ return Long_Float is
+ begin
+ return Long_Float (fl_valuator_get_maximum (This.Void_Ptr));
+ end Get_Maximum;
+
+
+ procedure Set_Maximum
+ (This : in out Valuator;
+ To : in Long_Float) is
+ begin
+ fl_valuator_set_maximum (This.Void_Ptr, Interfaces.C.double (To));
+ end Set_Maximum;
+
+
+ function Get_Step
+ (This : in Valuator)
+ return Long_Float is
+ begin
+ return Long_Float (fl_valuator_get_step (This.Void_Ptr));
+ end Get_Step;
+
+
+ procedure Set_Step_Top
+ (This : in out Valuator;
+ To : in Long_Float) is
+ begin
+ fl_valuator_set_step_top
+ (This.Void_Ptr,
+ Interfaces.C.double (To));
+ end Set_Step_Top;
+
+
+ procedure Set_Step_Bottom
+ (This : in out Valuator;
+ To : in Integer) is
+ begin
+ fl_valuator_set_step_bottom
+ (This.Void_Ptr,
+ Interfaces.C.int (To));
+ end Set_Step_Bottom;
+
+
+ procedure Set_Step
+ (This : in out Valuator;
+ Top : in Long_Float;
+ Bottom : in Integer) is
+ begin
+ fl_valuator_set_step
+ (This.Void_Ptr,
+ Interfaces.C.double (Top),
+ Interfaces.C.int (Bottom));
+ end Set_Step;
+
+
+ function Get_Value
+ (This : in Valuator)
+ return Long_Float is
+ begin
+ return Long_Float (fl_valuator_get_value (This.Void_Ptr));
+ end Get_Value;
+
+
+ procedure Set_Value
+ (This : in out Valuator;
+ To : in Long_Float) is
+ begin
+ fl_valuator_set_value (This.Void_Ptr, Interfaces.C.double (To));
+ end Set_Value;
+
+
+ procedure Set_Bounds
+ (This : in out Valuator;
+ Min, Max : in Long_Float) is
+ begin
+ fl_valuator_bounds
+ (This.Void_Ptr,
+ Interfaces.C.double (Min),
+ Interfaces.C.double (Max));
+ end Set_Bounds;
+
+
+ procedure Set_Precision
+ (This : in out Valuator;
+ To : in Integer) is
+ begin
+ fl_valuator_precision (This.Void_Ptr, Interfaces.C.int (To));
+ end Set_Precision;
+
+
+ procedure Set_Range
+ (This : in out Valuator;
+ Min, Max : in Long_Float) is
+ begin
+ fl_valuator_range
+ (This.Void_Ptr,
+ Interfaces.C.double (Min),
+ Interfaces.C.double (Max));
+ end Set_Range;
+
+
+
+
+ procedure Value_Damage
+ (This : in out Valuator) is
+ begin
+ fl_valuator_value_damage (This.Void_Ptr);
+ end Value_Damage;
+
+
+end FLTK.Widgets.Valuators;
+
+
diff --git a/body/fltk-widgets.adb b/body/fltk-widgets.adb
new file mode 100644
index 0000000..a312641
--- /dev/null
+++ b/body/fltk-widgets.adb
@@ -0,0 +1,1280 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Interfaces.C.Strings,
+ System.Address_To_Access_Conversions,
+ FLTK.Widgets.Groups.Windows,
+ FLTK.Images;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.unsigned,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets is
+
+
+ package Chk renames Ada.Assertions;
+
+
+ function "+"
+ (Left, Right : in Callback_Flag)
+ return Callback_Flag is
+ begin
+ return Left or Right;
+ end "+";
+
+
+ package Group_Convert is new
+ System.Address_To_Access_Conversions (FLTK.Widgets.Groups.Group'Class);
+
+ package Window_Convert is new
+ System.Address_To_Access_Conversions (FLTK.Widgets.Groups.Windows.Window'Class);
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_widget
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_widget, "new_fl_widget");
+ pragma Inline (new_fl_widget);
+
+ procedure free_fl_widget
+ (F : in Storage.Integer_Address);
+ pragma Import (C, free_fl_widget, "free_fl_widget");
+ pragma Inline (free_fl_widget);
+
+
+
+
+ procedure fl_widget_activate
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_activate, "fl_widget_activate");
+ pragma Inline (fl_widget_activate);
+
+ procedure fl_widget_deactivate
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_deactivate, "fl_widget_deactivate");
+ pragma Inline (fl_widget_deactivate);
+
+ function fl_widget_active
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_active, "fl_widget_active");
+ pragma Inline (fl_widget_active);
+
+ function fl_widget_active_r
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_active_r, "fl_widget_active_r");
+ pragma Inline (fl_widget_active_r);
+
+ procedure fl_widget_set_active
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_set_active, "fl_widget_set_active");
+ pragma Inline (fl_widget_set_active);
+
+ procedure fl_widget_clear_active
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_clear_active, "fl_widget_clear_active");
+ pragma Inline (fl_widget_clear_active);
+
+
+
+
+ function fl_widget_changed
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_widget_changed, "fl_widget_changed");
+ pragma Inline (fl_widget_changed);
+
+ procedure fl_widget_set_changed
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_set_changed, "fl_widget_set_changed");
+ pragma Inline (fl_widget_set_changed);
+
+ procedure fl_widget_clear_changed
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_clear_changed, "fl_widget_clear_changed");
+ pragma Inline (fl_widget_clear_changed);
+
+ function fl_widget_output
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_output, "fl_widget_output");
+ pragma Inline (fl_widget_output);
+
+ procedure fl_widget_set_output
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_set_output, "fl_widget_set_output");
+ pragma Inline (fl_widget_set_output);
+
+ procedure fl_widget_clear_output
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_clear_output, "fl_widget_clear_output");
+ pragma Inline (fl_widget_clear_output);
+
+ function fl_widget_visible
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_visible, "fl_widget_visible");
+ pragma Inline (fl_widget_visible);
+
+ function fl_widget_visible_r
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_visible_r, "fl_widget_visible_r");
+ pragma Inline (fl_widget_visible_r);
+
+ procedure fl_widget_set_visible
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_set_visible, "fl_widget_set_visible");
+ pragma Inline (fl_widget_set_visible);
+
+ procedure fl_widget_clear_visible
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_clear_visible, "fl_widget_clear_visible");
+ pragma Inline (fl_widget_clear_visible);
+
+
+
+
+ function fl_widget_get_visible_focus
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_visible_focus, "fl_widget_get_visible_focus");
+ pragma Inline (fl_widget_get_visible_focus);
+
+ procedure fl_widget_set_visible_focus
+ (W : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_widget_set_visible_focus, "fl_widget_set_visible_focus");
+ pragma Inline (fl_widget_set_visible_focus);
+
+ function fl_widget_take_focus
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_take_focus, "fl_widget_take_focus");
+ pragma Inline (fl_widget_take_focus);
+
+ function fl_widget_takesevents
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_takesevents, "fl_widget_takesevents");
+ pragma Inline (fl_widget_takesevents);
+
+
+
+
+ function fl_widget_get_color
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_widget_get_color, "fl_widget_get_color");
+ pragma Inline (fl_widget_get_color);
+
+ procedure fl_widget_set_color
+ (W : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned);
+ pragma Import (C, fl_widget_set_color, "fl_widget_set_color");
+ pragma Inline (fl_widget_set_color);
+
+ function fl_widget_get_selection_color
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_widget_get_selection_color, "fl_widget_get_selection_color");
+ pragma Inline (fl_widget_get_selection_color);
+
+ procedure fl_widget_set_selection_color
+ (W : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned);
+ pragma Import (C, fl_widget_set_selection_color, "fl_widget_set_selection_color");
+ pragma Inline (fl_widget_set_selection_color);
+
+
+
+
+ function fl_widget_get_parent
+ (W : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_widget_get_parent, "fl_widget_get_parent");
+ pragma Inline (fl_widget_get_parent);
+
+ function fl_widget_contains
+ (W, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_contains, "fl_widget_contains");
+ pragma Inline (fl_widget_contains);
+
+ function fl_widget_inside
+ (W, P : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_inside, "fl_widget_inside");
+ pragma Inline (fl_widget_inside);
+
+ function fl_widget_window
+ (W : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_widget_window, "fl_widget_window");
+ pragma Inline (fl_widget_window);
+
+ function fl_widget_top_window
+ (W : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_widget_top_window, "fl_widget_top_window");
+ pragma Inline (fl_widget_top_window);
+
+ function fl_widget_top_window_offset
+ (W : in Storage.Integer_Address;
+ X, Y : out Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_widget_top_window_offset, "fl_widget_top_window_offset");
+ pragma Inline (fl_widget_top_window_offset);
+
+
+
+
+ function fl_widget_get_align
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_widget_get_align, "fl_widget_get_align");
+ pragma Inline (fl_widget_get_align);
+
+ procedure fl_widget_set_align
+ (W : in Storage.Integer_Address;
+ A : in Interfaces.C.unsigned);
+ pragma Import (C, fl_widget_set_align, "fl_widget_set_align");
+ pragma Inline (fl_widget_set_align);
+
+ function fl_widget_get_box
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_box, "fl_widget_get_box");
+ pragma Inline (fl_widget_get_box);
+
+ procedure fl_widget_set_box
+ (W : in Storage.Integer_Address;
+ B : in Interfaces.C.int);
+ pragma Import (C, fl_widget_set_box, "fl_widget_set_box");
+ pragma Inline (fl_widget_set_box);
+
+ function fl_widget_tooltip
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_widget_tooltip, "fl_widget_tooltip");
+ pragma Inline (fl_widget_tooltip);
+
+ procedure fl_widget_copy_tooltip
+ (W : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_widget_copy_tooltip, "fl_widget_copy_tooltip");
+ pragma Inline (fl_widget_copy_tooltip);
+
+
+
+
+ function fl_widget_get_label
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_widget_get_label, "fl_widget_get_label");
+ pragma Inline (fl_widget_get_label);
+
+ function fl_widget_get_labelcolor
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_widget_get_labelcolor, "fl_widget_get_labelcolor");
+ pragma Inline (fl_widget_get_labelcolor);
+
+ procedure fl_widget_set_labelcolor
+ (W : in Storage.Integer_Address;
+ V : in Interfaces.C.unsigned);
+ pragma Import (C, fl_widget_set_labelcolor, "fl_widget_set_labelcolor");
+ pragma Inline (fl_widget_set_labelcolor);
+
+ function fl_widget_get_labelfont
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_labelfont, "fl_widget_get_labelfont");
+ pragma Inline (fl_widget_get_labelfont);
+
+ procedure fl_widget_set_labelfont
+ (W : in Storage.Integer_Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_widget_set_labelfont, "fl_widget_set_labelfont");
+ pragma Inline (fl_widget_set_labelfont);
+
+ function fl_widget_get_labelsize
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_labelsize, "fl_widget_get_labelsize");
+ pragma Inline (fl_widget_get_labelsize);
+
+ procedure fl_widget_set_labelsize
+ (W : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_widget_set_labelsize, "fl_widget_set_labelsize");
+ pragma Inline (fl_widget_set_labelsize);
+
+ function fl_widget_get_labeltype
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_labeltype, "fl_widget_get_labeltype");
+ pragma Inline (fl_widget_get_labeltype);
+
+ procedure fl_widget_set_labeltype
+ (W : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_widget_set_labeltype, "fl_widget_set_labeltype");
+ pragma Inline (fl_widget_set_labeltype);
+
+ procedure fl_widget_measure_label
+ (W : in Storage.Integer_Address;
+ D, H : out Interfaces.C.int);
+ pragma Import (C, fl_widget_measure_label, "fl_widget_measure_label");
+ pragma Inline (fl_widget_measure_label);
+
+
+
+
+ procedure fl_widget_set_callback
+ (W, C : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_set_callback, "fl_widget_set_callback");
+ pragma Inline (fl_widget_set_callback);
+
+ function fl_widget_get_when
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_widget_get_when, "fl_widget_get_when");
+ pragma Inline (fl_widget_get_when);
+
+ procedure fl_widget_set_when
+ (W : in Storage.Integer_Address;
+ T : in Interfaces.C.unsigned);
+ pragma Import (C, fl_widget_set_when, "fl_widget_set_when");
+ pragma Inline (fl_widget_set_when);
+
+
+
+
+ function fl_widget_get_x
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_x, "fl_widget_get_x");
+ pragma Inline (fl_widget_get_x);
+
+ function fl_widget_get_y
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_y, "fl_widget_get_y");
+ pragma Inline (fl_widget_get_y);
+
+ function fl_widget_get_w
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_w, "fl_widget_get_w");
+ pragma Inline (fl_widget_get_w);
+
+ function fl_widget_get_h
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_get_h, "fl_widget_get_h");
+ pragma Inline (fl_widget_get_h);
+
+ procedure fl_widget_size
+ (W : in Storage.Integer_Address;
+ D, H : in Interfaces.C.int);
+ pragma Import (C, fl_widget_size, "fl_widget_size");
+ pragma Inline (fl_widget_size);
+
+ procedure fl_widget_position
+ (W : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_widget_position, "fl_widget_position");
+ pragma Inline (fl_widget_position);
+
+
+
+
+ procedure fl_widget_set_image
+ (W, I : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_set_image, "fl_widget_set_image");
+ pragma Inline (fl_widget_set_image);
+
+ procedure fl_widget_set_deimage
+ (W, I : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_set_deimage, "fl_widget_set_deimage");
+ pragma Inline (fl_widget_set_deimage);
+
+
+
+
+ function fl_widget_damage
+ (W : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_damage, "fl_widget_damage");
+ pragma Inline (fl_widget_damage);
+
+ procedure fl_widget_set_damage
+ (W : in Storage.Integer_Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_widget_set_damage, "fl_widget_set_damage");
+ pragma Inline (fl_widget_set_damage);
+
+ procedure fl_widget_set_damage2
+ (W : in Storage.Integer_Address;
+ T : in Interfaces.C.int;
+ X, Y, D, H : in Interfaces.C.int);
+ pragma Import (C, fl_widget_set_damage2, "fl_widget_set_damage2");
+ pragma Inline (fl_widget_set_damage2);
+
+ procedure fl_widget_draw_label
+ (W : in Storage.Integer_Address;
+ X, Y, D, H : in Interfaces.C.int;
+ A : in Interfaces.C.unsigned);
+ pragma Import (C, fl_widget_draw_label, "fl_widget_draw_label");
+ pragma Inline (fl_widget_draw_label);
+
+ procedure fl_widget_redraw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_redraw, "fl_widget_redraw");
+ pragma Inline (fl_widget_redraw);
+
+ procedure fl_widget_redraw_label
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_redraw_label, "fl_widget_redraw_label");
+ pragma Inline (fl_widget_redraw_label);
+
+
+
+
+ procedure fl_widget_draw
+ (W : in Storage.Integer_Address);
+ pragma Import (C, fl_widget_draw, "fl_widget_draw");
+ pragma Inline (fl_widget_draw);
+
+ function fl_widget_handle
+ (W : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_widget_handle, "fl_widget_handle");
+ pragma Inline (fl_widget_handle);
+
+
+
+
+ ----------------------
+ -- Exported Hooks --
+ ----------------------
+
+ procedure Callback_Hook
+ (W, U : in Storage.Integer_Address)
+ is
+ Ada_Widget : access Widget'Class :=
+ Widget_Convert.To_Pointer (Storage.To_Address (U));
+ begin
+ Ada_Widget.Callback.all (Ada_Widget.all);
+ end Callback_Hook;
+
+
+ procedure Draw_Hook
+ (U : in Storage.Integer_Address)
+ is
+ Ada_Widget : access Widget'Class :=
+ Widget_Convert.To_Pointer (Storage.To_Address (U));
+ begin
+ Ada_Widget.Draw;
+ end Draw_Hook;
+
+
+ function Handle_Hook
+ (U : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int
+ is
+ Ada_Widget : access Widget'Class :=
+ Widget_Convert.To_Pointer (Storage.To_Address (U));
+ begin
+ return Event_Outcome'Pos (Ada_Widget.Handle (Event_Kind'Val (E)));
+ end Handle_Hook;
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out Widget)
+ is
+ Maybe_Parent : access FLTK.Widgets.Groups.Group'Class := This.Parent;
+ begin
+ if Maybe_Parent /= null then
+ Maybe_Parent.Remove (This);
+ end if;
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Widget) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_widget (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Widget;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ fl_widget_set_user_data
+ (This.Void_Ptr,
+ Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access)));
+ fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text));
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Widget) is
+ begin
+ This.Draw_Ptr := fl_widget_draw'Address;
+ This.Handle_Ptr := fl_widget_handle'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Widget is
+ begin
+ return This : Widget do
+ This.Void_Ptr := new_fl_widget
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Widget is
+ begin
+ return This : Widget := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Activate
+ (This : in out Widget) is
+ begin
+ fl_widget_activate (This.Void_Ptr);
+ end Activate;
+
+
+ procedure Deactivate
+ (This : in out Widget) is
+ begin
+ fl_widget_deactivate (This.Void_Ptr);
+ end Deactivate;
+
+
+ function Is_Active
+ (This : in Widget)
+ return Boolean is
+ begin
+ return fl_widget_active (This.Void_Ptr) /= 0;
+ end Is_Active;
+
+
+ function Is_Tree_Active
+ (This : in Widget)
+ return Boolean is
+ begin
+ return fl_widget_active_r (This.Void_Ptr) /= 0;
+ end Is_Tree_Active;
+
+
+ procedure Set_Active
+ (This : in out Widget;
+ To : in Boolean) is
+ begin
+ if To then
+ fl_widget_set_active (This.Void_Ptr);
+ else
+ fl_widget_clear_active (This.Void_Ptr);
+ end if;
+ end Set_Active;
+
+
+
+
+ function Has_Changed
+ (This : in Widget)
+ return Boolean is
+ begin
+ return fl_widget_changed (This.Void_Ptr) /= 0;
+ end Has_Changed;
+
+
+ procedure Set_Changed
+ (This : in out Widget;
+ To : in Boolean) is
+ begin
+ if To then
+ fl_widget_set_changed (This.Void_Ptr);
+ else
+ fl_widget_clear_changed (This.Void_Ptr);
+ end if;
+ end Set_Changed;
+
+
+ function Is_Output_Only
+ (This : in Widget)
+ return Boolean is
+ begin
+ return fl_widget_output (This.Void_Ptr) /= 0;
+ end Is_Output_Only;
+
+
+ procedure Set_Output_Only
+ (This : in out Widget;
+ To : in Boolean) is
+ begin
+ if To then
+ fl_widget_set_output (This.Void_Ptr);
+ else
+ fl_widget_clear_output (This.Void_Ptr);
+ end if;
+ end Set_Output_Only;
+
+
+ function Is_Visible
+ (This : in Widget)
+ return Boolean is
+ begin
+ return fl_widget_visible (This.Void_Ptr) /= 0;
+ end Is_Visible;
+
+
+ function Is_Tree_Visible
+ (This : in Widget)
+ return Boolean is
+ begin
+ return fl_widget_visible_r (This.Void_Ptr) /= 0;
+ end Is_Tree_Visible;
+
+
+ procedure Set_Visible
+ (This : in out Widget;
+ To : in Boolean) is
+ begin
+ if To then
+ fl_widget_set_visible (This.Void_Ptr);
+ else
+ fl_widget_clear_visible (This.Void_Ptr);
+ end if;
+ end Set_Visible;
+
+
+
+
+ function Has_Visible_Focus
+ (This : in Widget)
+ return Boolean is
+ begin
+ return fl_widget_get_visible_focus (This.Void_Ptr) /= 0;
+ end Has_Visible_Focus;
+
+
+ procedure Set_Visible_Focus
+ (This : in out Widget;
+ To : in Boolean) is
+ begin
+ fl_widget_set_visible_focus (This.Void_Ptr, Boolean'Pos (To));
+ end Set_Visible_Focus;
+
+
+ function Take_Focus
+ (This : in out Widget)
+ return Boolean is
+ begin
+ return fl_widget_take_focus (This.Void_Ptr) /= 0;
+ end Take_Focus;
+
+
+ function Takes_Events
+ (This : in Widget)
+ return Boolean is
+ begin
+ return fl_widget_takesevents (This.Void_Ptr) /= 0;
+ end Takes_Events;
+
+
+
+
+ function Get_Background_Color
+ (This : in Widget)
+ return Color is
+ begin
+ return Color (fl_widget_get_color (This.Void_Ptr));
+ end Get_Background_Color;
+
+
+ procedure Set_Background_Color
+ (This : in out Widget;
+ To : in Color) is
+ begin
+ fl_widget_set_color (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Background_Color;
+
+
+ function Get_Selection_Color
+ (This : in Widget)
+ return Color is
+ begin
+ return Color (fl_widget_get_selection_color (This.Void_Ptr));
+ end Get_Selection_Color;
+
+
+ procedure Set_Selection_Color
+ (This : in out Widget;
+ To : in Color) is
+ begin
+ fl_widget_set_selection_color (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Selection_Color;
+
+
+
+
+ function Parent
+ (This : in Widget)
+ return access FLTK.Widgets.Groups.Group'Class
+ is
+ Parent_Ptr : Storage.Integer_Address := fl_widget_get_parent (This.Void_Ptr);
+ Actual_Parent : access FLTK.Widgets.Groups.Group'Class;
+ begin
+ if Parent_Ptr /= Null_Pointer then
+ Parent_Ptr := fl_widget_get_user_data (Parent_Ptr);
+ pragma Assert (Parent_Ptr /= Null_Pointer);
+ Actual_Parent := Group_Convert.To_Pointer (Storage.To_Address (Parent_Ptr));
+ end if;
+ return Actual_Parent;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Parent;
+
+
+ function Contains
+ (This : in Widget;
+ Item : in Widget'Class)
+ return Boolean is
+ begin
+ return fl_widget_contains (This.Void_Ptr, Item.Void_Ptr) /= 0;
+ end Contains;
+
+
+ function Inside
+ (This : in Widget;
+ Parent : in Widget'Class)
+ return Boolean is
+ begin
+ return fl_widget_inside (This.Void_Ptr, Parent.Void_Ptr) /= 0;
+ end Inside;
+
+
+ function Nearest_Window
+ (This : in Widget)
+ return access FLTK.Widgets.Groups.Windows.Window'Class
+ is
+ Window_Ptr : Storage.Integer_Address := fl_widget_window (This.Void_Ptr);
+ Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class;
+ begin
+ if Window_Ptr /= Null_Pointer then
+ Window_Ptr := fl_widget_get_user_data (Window_Ptr);
+ pragma Assert (Window_Ptr /= Null_Pointer);
+ Actual_Window := Window_Convert.To_Pointer (Storage.To_Address (Window_Ptr));
+ end if;
+ return Actual_Window;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Nearest_Window;
+
+
+ function Top_Window
+ (This : in Widget)
+ return access FLTK.Widgets.Groups.Windows.Window'Class
+ is
+ Window_Ptr : Storage.Integer_Address := fl_widget_top_window (This.Void_Ptr);
+ Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class;
+ begin
+ if Window_Ptr /= Null_Pointer then
+ Window_Ptr := fl_widget_get_user_data (Window_Ptr);
+ pragma Assert (Window_Ptr /= Null_Pointer);
+ Actual_Window := Window_Convert.To_Pointer (Storage.To_Address (Window_Ptr));
+ end if;
+ return Actual_Window;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Top_Window;
+
+
+ function Top_Window_Offset
+ (This : in Widget;
+ Offset_X, Offset_Y : out Integer)
+ return access FLTK.Widgets.Groups.Windows.Window'Class
+ is
+ Window_Ptr : Storage.Integer_Address := fl_widget_top_window_offset
+ (This.Void_Ptr,
+ Interfaces.C.int (Offset_X),
+ Interfaces.C.int (Offset_Y));
+ Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class;
+ begin
+ if Window_Ptr /= Null_Pointer then
+ Window_Ptr := fl_widget_get_user_data (Window_Ptr);
+ pragma Assert (Window_Ptr /= Null_Pointer);
+ Actual_Window := Window_Convert.To_Pointer (Storage.To_Address (Window_Ptr));
+ end if;
+ return Actual_Window;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error;
+ end Top_Window_Offset;
+
+
+
+
+ function Get_Alignment
+ (This : in Widget)
+ return Alignment is
+ begin
+ return Alignment (fl_widget_get_align (This.Void_Ptr));
+ end Get_Alignment;
+
+
+ procedure Set_Alignment
+ (This : in out Widget;
+ New_Align : in Alignment) is
+ begin
+ fl_widget_set_align (This.Void_Ptr, Interfaces.C.unsigned (New_Align));
+ end Set_Alignment;
+
+
+ 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_Tooltip
+ (This : in Widget)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_widget_tooltip (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ -- no need for dealloc
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Get_Tooltip;
+
+
+ procedure Set_Tooltip
+ (This : in out Widget;
+ Text : in String) is
+ begin
+ fl_widget_copy_tooltip (This.Void_Ptr, Interfaces.C.To_C (Text));
+ end Set_Tooltip;
+
+
+
+
+ function Get_Label
+ (This : in Widget)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_widget_get_label (This.Void_Ptr);
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ 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_Color
+ (This : in Widget)
+ return Color is
+ begin
+ return Color (fl_widget_get_labelcolor (This.Void_Ptr));
+ end Get_Label_Color;
+
+
+ procedure Set_Label_Color
+ (This : in out Widget;
+ Value : in Color) is
+ begin
+ fl_widget_set_labelcolor (This.Void_Ptr, Interfaces.C.unsigned (Value));
+ end Set_Label_Color;
+
+
+ function Get_Label_Font
+ (This : in Widget)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_widget_get_labelfont (This.Void_Ptr));
+ end Get_Label_Font;
+
+
+ procedure Set_Label_Font
+ (This : in out Widget;
+ Font : in Font_Kind) is
+ begin
+ fl_widget_set_labelfont (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_labelsize (This.Void_Ptr));
+ end Get_Label_Size;
+
+
+ procedure Set_Label_Size
+ (This : in out Widget;
+ Size : in Font_Size) is
+ begin
+ fl_widget_set_labelsize (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Label_Size;
+
+
+ function Get_Label_Kind
+ (This : in Widget)
+ return Label_Kind
+ is
+ Result : Interfaces.C.int := fl_widget_get_labeltype (This.Void_Ptr);
+ begin
+ return Label_Kind'Val (Result);
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error with
+ "Fl_Widget::labeltype returned unexpected int value of " &
+ Interfaces.C.int'Image (Result);
+ end Get_Label_Kind;
+
+
+ procedure Set_Label_Kind
+ (This : in out Widget;
+ Label : in Label_Kind) is
+ begin
+ fl_widget_set_labeltype (This.Void_Ptr, Label_Kind'Pos (Label));
+ end Set_Label_Kind;
+
+
+ procedure Measure_Label
+ (This : in Widget;
+ W, H : out Integer) is
+ begin
+ fl_widget_measure_label
+ (This.Void_Ptr,
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Measure_Label;
+
+
+
+
+ function Get_Callback
+ (This : in Widget)
+ return Widget_Callback is
+ begin
+ return This.Callback;
+ end Get_Callback;
+
+
+ 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, Storage.To_Integer (Callback_Hook'Address));
+ end if;
+ end Set_Callback;
+
+
+ procedure Do_Callback
+ (This : in out Widget) is
+ begin
+ if This.Callback /= null then
+ This.Callback.all (This);
+ end if;
+ end Do_Callback;
+
+
+ function Get_When
+ (This : in Widget)
+ return Callback_Flag is
+ begin
+ return Callback_Flag (fl_widget_get_when (This.Void_Ptr));
+ end Get_When;
+
+
+ procedure Set_When
+ (This : in out Widget;
+ To : in Callback_Flag) is
+ begin
+ fl_widget_set_when (This.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_When;
+
+
+
+
+ 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;
+
+
+ function Get_Inactive_Image
+ (This : in Widget)
+ return access FLTK.Images.Image'Class is
+ begin
+ return This.Inactive_Image;
+ end Get_Inactive_Image;
+
+
+ procedure Set_Inactive_Image
+ (This : in out Widget;
+ Pic : in out FLTK.Images.Image'Class) is
+ begin
+ This.Inactive_Image := Pic'Unchecked_Access;
+ fl_widget_set_deimage
+ (This.Void_Ptr,
+ Wrapper (Pic).Void_Ptr);
+ end Set_Inactive_Image;
+
+
+
+
+ function Is_Damaged
+ (This : in Widget)
+ return Boolean is
+ begin
+ return fl_widget_damage (This.Void_Ptr) /= 0;
+ end Is_Damaged;
+
+
+ procedure Set_Damaged
+ (This : in out Widget;
+ To : in Boolean) is
+ begin
+ fl_widget_set_damage (This.Void_Ptr, Boolean'Pos (To));
+ end Set_Damaged;
+
+
+ procedure Set_Damaged
+ (This : in out Widget;
+ To : in Boolean;
+ X, Y, W, H : in Integer) is
+ begin
+ fl_widget_set_damage2
+ (This.Void_Ptr,
+ Boolean'Pos (To),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Set_Damaged;
+
+
+ procedure Draw
+ (This : in out Widget)
+ is
+ procedure my_draw
+ (V : in Storage.Integer_Address);
+ for my_draw'Address use This.Draw_Ptr;
+ pragma Import (Ada, my_draw);
+ begin
+ my_draw (This.Void_Ptr);
+ end Draw;
+
+
+ procedure Draw_Label
+ (This : in Widget;
+ X, Y, W, H : in Integer;
+ Align : in Alignment) is
+ begin
+ fl_widget_draw_label
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.unsigned (Align));
+ end Draw_Label;
+
+
+ procedure Redraw
+ (This : in out Widget) is
+ begin
+ fl_widget_redraw (This.Void_Ptr);
+ end Redraw;
+
+
+ procedure Redraw_Label
+ (This : in out Widget) is
+ begin
+ fl_widget_redraw_label (This.Void_Ptr);
+ end Redraw_Label;
+
+
+ function Handle
+ (This : in out Widget;
+ Event : in Event_Kind)
+ return Event_Outcome
+ is
+ function my_handle
+ (V : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ for my_handle'Address use This.Handle_Ptr;
+ pragma Import (Ada, my_handle);
+ begin
+ return Event_Outcome'Val (my_handle (This.Void_Ptr, Event_Kind'Pos (Event)));
+ exception
+ when Constraint_Error => raise Internal_FLTK_Error;
+ end Handle;
+
+
+end FLTK.Widgets;
+
diff --git a/body/fltk.adb b/body/fltk.adb
new file mode 100644
index 0000000..d729364
--- /dev/null
+++ b/body/fltk.adb
@@ -0,0 +1,425 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Interfaces.C;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.unsigned_long;
+
+
+package body FLTK is
+
+
+ function fl_enum_rgb_color
+ (R, G, B : in Interfaces.C.unsigned_char)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_enum_rgb_color, "fl_enum_rgb_color");
+ pragma Inline (fl_enum_rgb_color);
+
+
+
+
+ function fl_abi_check
+ (V : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_abi_check, "fl_abi_check");
+ pragma Inline (fl_abi_check);
+
+ function fl_abi_version
+ return Interfaces.C.int;
+ pragma Import (C, fl_abi_version, "fl_abi_version");
+ pragma Inline (fl_abi_version);
+
+ function fl_api_version
+ return Interfaces.C.int;
+ pragma Import (C, fl_api_version, "fl_api_version");
+ pragma Inline (fl_api_version);
+
+ function fl_version
+ return Interfaces.C.double;
+ pragma Import (C, fl_version, "fl_version");
+ pragma Inline (fl_version);
+
+
+
+
+ function fl_get_damage
+ return Interfaces.C.int;
+ pragma Import (C, fl_get_damage, "fl_get_damage");
+ pragma Inline (fl_get_damage);
+
+ procedure fl_set_damage
+ (V : in Interfaces.C.int);
+ pragma Import (C, fl_set_damage, "fl_set_damage");
+ pragma Inline (fl_set_damage);
+
+
+
+
+ function fl_check
+ return Interfaces.C.int;
+ pragma Import (C, fl_check, "fl_check");
+ pragma Inline (fl_check);
+
+ function fl_ready
+ return Interfaces.C.int;
+ pragma Import (C, fl_ready, "fl_ready");
+ pragma Inline (fl_ready);
+
+ function fl_wait
+ return Interfaces.C.int;
+ pragma Import (C, fl_wait, "fl_wait");
+ pragma Inline (fl_wait);
+
+ function fl_wait2
+ (S : in Interfaces.C.double)
+ return Interfaces.C.int;
+ pragma Import (C, fl_wait2, "fl_wait2");
+ pragma Inline (fl_wait2);
+
+ function fl_run
+ return Interfaces.C.int;
+ pragma Import (C, fl_run, "fl_run");
+ pragma Inline (fl_run);
+
+
+
+
+ function Is_Valid
+ (Object : in Wrapper)
+ return Boolean is
+ begin
+ return Object.Void_Ptr /= Null_Pointer;
+ end Is_Valid;
+
+
+ procedure Initialize
+ (This : in out Wrapper) is
+ begin
+ This.Void_Ptr := Null_Pointer;
+ end Initialize;
+
+
+
+
+ function RGB_Color
+ (R, G, B : in Color_Component)
+ return Color is
+ begin
+ return Color (fl_enum_rgb_color
+ (Interfaces.C.unsigned_char (R),
+ Interfaces.C.unsigned_char (G),
+ Interfaces.C.unsigned_char (B)));
+ end RGB_Color;
+
+
+
+
+ function "+"
+ (Left, Right : in Alignment)
+ return Alignment is
+ begin
+ return Left or Right;
+ end "+";
+
+
+ function "-"
+ (Left, Right : in Alignment)
+ return Alignment is
+ begin
+ return Left and (not Right);
+ end "-";
+
+
+
+
+ function Press
+ (Key : in Pressable_Key)
+ return Keypress is
+ begin
+ return Character'Pos (Key);
+ end Press;
+
+
+ function Press
+ (Key : Pressable_Key)
+ return Key_Combo is
+ begin
+ return This : Key_Combo do
+ This.Modcode := Mod_None;
+ This.Keycode := Character'Pos (Key);
+ This.Mousecode := No_Button;
+ end return;
+ end Press;
+
+
+ function Press
+ (Key : in Keypress)
+ return Key_Combo is
+ begin
+ return This : Key_Combo do
+ This.Modcode := Mod_None;
+ This.Keycode := Key;
+ This.Mousecode := No_Button;
+ end return;
+ end Press;
+
+
+ function Press
+ (Key : in Mouse_Button)
+ return Key_Combo is
+ begin
+ return This : Key_Combo do
+ This.Modcode := Mod_None;
+ This.Keycode := 0;
+ This.Mousecode := Key;
+ end return;
+ end Press;
+
+
+
+
+ function "+"
+ (Left, Right : in Modifier)
+ return Modifier is
+ begin
+ return Left or Right;
+ end "+";
+
+
+ function "+"
+ (Left : in Modifier;
+ Right : in Pressable_Key)
+ return Key_Combo is
+ begin
+ return This : Key_Combo do
+ This.Modcode := Left;
+ This.Keycode := Character'Pos (Right);
+ This.Mousecode := No_Button;
+ end return;
+ end "+";
+
+
+ function "+"
+ (Left : in Modifier;
+ Right : in Keypress)
+ return Key_Combo is
+ begin
+ return This : Key_Combo do
+ This.Modcode := Left;
+ This.Keycode := Right;
+ This.Mousecode := No_Button;
+ end return;
+ end "+";
+
+
+ function "+"
+ (Left : in Modifier;
+ Right : in Mouse_Button)
+ return Key_Combo is
+ begin
+ return This : Key_Combo do
+ This.Modcode := Left;
+ This.Keycode := 0;
+ This.Mousecode := Right;
+ end return;
+ end "+";
+
+
+ function "+"
+ (Left : in Modifier;
+ Right : in Key_Combo)
+ return Key_Combo is
+ begin
+ return This : Key_Combo do
+ This.Modcode := Left or Right.Modcode;
+ This.Keycode := Right.Keycode;
+ This.Mousecode := Right.Mousecode;
+ end return;
+ end "+";
+
+
+
+
+ function To_C
+ (Key : in Key_Combo)
+ return Interfaces.C.int is
+ begin
+ return To_C (Key.Modcode) + To_C (Key.Keycode) + To_C (Key.Mousecode);
+ end To_C;
+
+
+ function To_Ada
+ (Key : in Interfaces.C.int)
+ return Key_Combo is
+ begin
+ return Result : Key_Combo do
+ Result.Modcode := To_Ada (Key);
+ Result.Keycode := To_Ada (Key);
+ Result.Mousecode := To_Ada (Key);
+ end return;
+ end To_Ada;
+
+
+ function To_C
+ (Key : in Keypress)
+ return Interfaces.C.int is
+ begin
+ return Interfaces.C.int (Key);
+ end To_C;
+
+
+ function To_Ada
+ (Key : in Interfaces.C.int)
+ return Keypress is
+ begin
+ return Keypress (Key mod 65536);
+ end To_Ada;
+
+
+ function To_C
+ (Modi : in Modifier)
+ return Interfaces.C.int is
+ begin
+ return Interfaces.C.int (Modi) * 65536;
+ end To_C;
+
+
+ function To_Ada
+ (Modi : in Interfaces.C.int)
+ return Modifier is
+ begin
+ return Modifier ((Modi / 65536) mod 256);
+ end To_Ada;
+
+
+ function To_C
+ (Button : in Mouse_Button)
+ return Interfaces.C.int is
+ begin
+ case Button is
+ when Left_Button => return 1 * (256 ** 3);
+ when Middle_Button => return 2 * (256 ** 3);
+ when Right_Button => return 4 * (256 ** 3);
+ when others => return 0;
+ end case;
+ end To_C;
+
+
+ function To_Ada
+ (Button : in Interfaces.C.int)
+ return Mouse_Button is
+ begin
+ case (Button / (256 ** 3)) is
+ when 1 => return Left_Button;
+ when 2 => return Middle_Button;
+ when 4 => return Right_Button;
+ when others => return No_Button;
+ end case;
+ end To_Ada;
+
+
+
+
+ function "+"
+ (Left, Right : in Menu_Flag)
+ return Menu_Flag is
+ begin
+ return Left or Right;
+ end "+";
+
+
+
+
+ function ABI_Check
+ (ABI_Ver : in Version_Number)
+ return Boolean is
+ begin
+ return fl_abi_check (Interfaces.C.int (ABI_Ver)) /= 0;
+ end ABI_Check;
+
+
+ function ABI_Version
+ return Version_Number is
+ begin
+ return Version_Number (fl_abi_version);
+ end ABI_Version;
+
+
+ function API_Version
+ return Version_Number is
+ begin
+ return Version_Number (fl_api_version);
+ end API_Version;
+
+
+ function Version
+ return Version_Number is
+ begin
+ return Version_Number (fl_version);
+ end Version;
+
+
+
+
+ function Is_Damaged
+ return Boolean is
+ begin
+ return fl_get_damage /= 0;
+ end Is_Damaged;
+
+
+ procedure Set_Damaged
+ (To : in Boolean) is
+ begin
+ fl_set_damage (Boolean'Pos (To));
+ end Set_Damaged;
+
+
+
+
+ function Check
+ return Boolean is
+ begin
+ return fl_check /= 0;
+ end Check;
+
+
+ function Ready
+ return Boolean is
+ begin
+ return fl_ready /= 0;
+ end Ready;
+
+
+ function Wait
+ return Integer is
+ begin
+ return Integer (fl_wait);
+ end Wait;
+
+
+ function Wait
+ (Seconds : in Long_Float)
+ return Integer is
+ begin
+ return Integer (fl_wait2 (Interfaces.C.double (Seconds)));
+ end Wait;
+
+
+ function Run
+ return Integer is
+ begin
+ return Integer (fl_run);
+ end Run;
+
+
+end FLTK;
+