summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/fl_choice.html130
-rw-r--r--doc/fl_gif_image.html65
-rw-r--r--doc/fl_menu_.html12
-rw-r--r--doc/fl_pixmap.html153
-rw-r--r--doc/fl_xpm_image.html65
-rw-r--r--doc/index.html12
-rw-r--r--progress.txt43
-rw-r--r--src/c_fl_choice.cpp85
-rw-r--r--src/c_fl_choice.h34
-rw-r--r--src/c_fl_gif_image.cpp17
-rw-r--r--src/c_fl_gif_image.h19
-rw-r--r--src/c_fl_menu.cpp8
-rw-r--r--src/c_fl_menu.h2
-rw-r--r--src/c_fl_pixmap.cpp44
-rw-r--r--src/c_fl_pixmap.h28
-rw-r--r--src/c_fl_xpm_image.cpp17
-rw-r--r--src/c_fl_xpm_image.h19
-rw-r--r--src/fltk-images-pixmaps-gif.adb71
-rw-r--r--src/fltk-images-pixmaps-gif.ads33
-rw-r--r--src/fltk-images-pixmaps-xpm.adb71
-rw-r--r--src/fltk-images-pixmaps-xpm.ads33
-rw-r--r--src/fltk-images-pixmaps.adb157
-rw-r--r--src/fltk-images-pixmaps.ads67
-rw-r--r--src/fltk-widgets-menus-choices.adb182
-rw-r--r--src/fltk-widgets-menus-choices.ads75
-rw-r--r--src/fltk-widgets-menus.adb33
-rw-r--r--src/fltk-widgets-menus.ads9
27 files changed, 1457 insertions, 27 deletions
diff --git a/doc/fl_choice.html b/doc/fl_choice.html
new file mode 100644
index 0000000..34b8778
--- /dev/null
+++ b/doc/fl_choice.html
@@ -0,0 +1,130 @@
+
+<!DOCTYPE html>
+
+<html lang="en">
+ <head>
+ <meta charset="utf-8">
+ <title>Fl_Choice Binding Map</title>
+ <link href="map.css" rel="stylesheet">
+ </head>
+
+ <body>
+
+
+<h2>Fl_Choice Binding Map</h2>
+
+
+<table class="package">
+ <tr><th colspan="2">Package name</th></tr>
+
+ <tr>
+ <td>Fl_Choice</td>
+ <td>FLTK.Widgets.Menus.Choices</td>
+ </tr>
+
+</table>
+
+
+
+<table class="type">
+ <tr><th colspan="2">Types</th></tr>
+
+ <tr>
+ <td>Fl_Choice</td>
+ <td>Choice</td>
+ </tr>
+
+ <tr>
+ <td>&nbsp;</td>
+ <td>Choice_Reference</td>
+ </tr>
+
+</table>
+
+
+
+<table class="function">
+ <tr><th colspan="2">Functions and Procedures</th></tr>
+
+ <tr>
+<td><pre>
+Fl_Choice(int X, int Y, int W, int H, const char *L=0);
+</pre></td>
+<td><pre>
+function Create
+ (X, Y, W, H : in Integer;
+ Text : in String)
+ return Choice;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void draw();
+</pre></td>
+<td><pre>
+procedure Draw
+ (This : in out Choice);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int handle(int);
+</pre></td>
+<td><pre>
+function Handle
+ (This : in out Choice;
+ Event : in Event_Kind)
+ return Event_Outcome;
+</pre></td>
+ </tr>
+
+ <tr>
+<td>&nbsp;</td>
+<td><pre>
+function Chosen
+ (This : in Choice)
+ return FLTK.Menu_Items.Menu_Item_Reference;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int value() const;
+</pre></td>
+<td><pre>
+function Chosen_Index
+ (This : in Choice)
+ return Extended_Index;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int value(int v);
+</pre></td>
+<td><pre>
+procedure Set_Chosen
+ (This : in out Choice;
+ Place : in Index);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int value(const Fl_Menu_Item *v);
+</pre></td>
+<td><pre>
+procedure Set_Chosen
+ (This : in out Choice;
+ Item : in FLTK.Menu_Items.Menu_Item);
+</pre></td>
+ </tr>
+
+</table>
+
+
+ </body>
+</html>
+
diff --git a/doc/fl_gif_image.html b/doc/fl_gif_image.html
new file mode 100644
index 0000000..6117095
--- /dev/null
+++ b/doc/fl_gif_image.html
@@ -0,0 +1,65 @@
+
+<!DOCTYPE html>
+
+<html lang="en">
+ <head>
+ <meta charset="utf-8">
+ <title>Fl_GIF_Image Binding Map</title>
+ <link href="map.css" rel="stylesheet">
+ </head>
+
+ <body>
+
+
+<h2>Fl_GIF_Image Binding Map</h2>
+
+
+<table class="package">
+ <tr><th colspan="2">Package name</th></tr>
+
+ <tr>
+ <td>Fl_GIF_Image</td>
+ <td>FLTK.Images.Pixmaps.GIF</td>
+ </tr>
+
+</table>
+
+
+
+<table class="type">
+ <tr><th colspan="2">Types</th></tr>
+
+ <tr>
+ <td>Fl_GIF_Image</td>
+ <td>GIF_Image</td>
+ </tr>
+
+ <tr>
+ <td>&nbsp;</td>
+ <td>GIF_Image_Reference</td>
+ </tr>
+
+</table>
+
+
+
+<table class="function">
+ <tr><th colspan="2">Functions and Procedures</th></tr>
+
+ <tr>
+<td><pre>
+Fl_GIF_Image(const char *filename);
+</pre></td>
+<td><pre>
+function Create
+ (Filename : in String)
+ return GIF_Image;
+</pre></td>
+ </tr>
+
+</table>
+
+
+ </body>
+</html>
+
diff --git a/doc/fl_menu_.html b/doc/fl_menu_.html
index 2c3ae6c..731c16e 100644
--- a/doc/fl_menu_.html
+++ b/doc/fl_menu_.html
@@ -572,14 +572,22 @@ function Chosen_Index
<td><pre>
int value(const Fl_Menu_Item *);
</pre></td>
-<td>&nbsp;</td>
+<td><pre>
+procedure Set_Chosen
+ (This : in out Menu;
+ Item : in FLTK.Menu_Items.Menu_Item);
+</pre></td>
</tr>
<tr>
<td><pre>
int value(int i);
</pre></td>
-<td>&nbsp;</td>
+<td><pre>
+procedure Set_Chosen
+ (This : in out Menu;
+ Place : in Index);
+</pre></td>
</tr>
</table>
diff --git a/doc/fl_pixmap.html b/doc/fl_pixmap.html
new file mode 100644
index 0000000..de528e6
--- /dev/null
+++ b/doc/fl_pixmap.html
@@ -0,0 +1,153 @@
+
+<!DOCTYPE html>
+
+<html lang="en">
+ <head>
+ <meta charset="utf-8">
+ <title>Fl_Pixmap Binding Map</title>
+ <link href="map.css" rel="stylesheet">
+ </head>
+
+ <body>
+
+
+<h2>Fl_Pixmap Binding Map</h2>
+
+
+<table class="package">
+ <tr><th colspan="2">Package name</th></tr>
+
+ <tr>
+ <td>Fl_Pixmap</td>
+ <td>FLTK.Images.Pixmaps</td>
+ </tr>
+
+</table>
+
+
+
+<table class="type">
+ <tr><th colspan="2">Types</th></tr>
+
+ <tr>
+ <td>Fl_Pixmap</td>
+ <td>Pixmap</td>
+ </tr>
+
+ <tr>
+ <td>&nbsp;</td>
+ <td>Pixmap_Reference</td>
+ </tr>
+
+</table>
+
+
+
+<table class="function">
+ <tr><th colspan="2">Functions and Procedures</th></tr>
+
+ <tr>
+<td><pre>
+Fl_Pixmap(char *const *D);
+Fl_Pixmap(uchar *const *D);
+Fl_Pixmap(const char *const *D);
+Fl_Pixmap(const uchar *const *D);
+</pre></td>
+<td>&nbsp;</td>
+ </tr>
+
+ <tr>
+<td><pre>
+virtual void color_average(Fl_Color c, float i);
+</pre></td>
+<td><pre>
+procedure Color_Average
+ (This : in out Pixmap;
+ Col : in Color;
+ Amount : in Blend);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+virtual Fl_Image * copy(int W, int H);
+</pre></td>
+<td><pre>
+function Copy
+ (This : in Pixmap;
+ Width, Height : in Natural)
+ return Pixmap'Class;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+Fl_Image * copy();
+</pre></td>
+<td><pre>
+function Copy
+ (This : in Pixmap)
+ return Pixmap'Class;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+virtual void desaturate();
+</pre></td>
+<td><pre>
+procedure Desaturate
+ (This : in out Pixmap);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+virtual void draw(int X, int Y, int W, int H, int cx=0, int cy=0);
+</pre></td>
+<td><pre>
+procedure Draw
+ (This : in Pixmap;
+ X, Y, W, H : in Integer;
+ CX, CY : in Integer := 0);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void draw(int X, int Y);
+</pre></td>
+<td><pre>
+procedure Draw
+ (This : in Pixmap;
+ X, Y : in Integer);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+virtual void label(Fl_Widget *w);
+</pre></td>
+<td>&nbsp;</td>
+ </tr>
+
+ <tr>
+<td><pre>
+virtual void label(Fl_Menu_Item *m);
+</pre></td>
+<td>&nbsp;</td>
+ </tr>
+
+ <tr>
+<td><pre>
+virtual void uncache();
+</pre></td>
+<td>&nbsp;</td>
+ </tr>
+
+</table>
+
+
+ </body>
+</html>
+
diff --git a/doc/fl_xpm_image.html b/doc/fl_xpm_image.html
new file mode 100644
index 0000000..72e95b4
--- /dev/null
+++ b/doc/fl_xpm_image.html
@@ -0,0 +1,65 @@
+
+<!DOCTYPE html>
+
+<html lang="en">
+ <head>
+ <meta charset="utf-8">
+ <title>Fl_XPM_Image Binding Map</title>
+ <link href="map.css" rel="stylesheet">
+ </head>
+
+ <body>
+
+
+<h2>Fl_XPM_Image Binding Map</h2>
+
+
+<table class="package">
+ <tr><th colspan="2">Package name</th></tr>
+
+ <tr>
+ <td>Fl_XPM_Image</td>
+ <td>FLTK.Images.Pixmaps.XPM</td>
+ </tr>
+
+</table>
+
+
+
+<table class="type">
+ <tr><th colspan="2">Types</th></tr>
+
+ <tr>
+ <td>Fl_XPM_Image</td>
+ <td>XPM_Image</td>
+ </tr>
+
+ <tr>
+ <td>&nbsp;</td>
+ <td>XPM_Image_Reference</td>
+ </tr>
+
+</table>
+
+
+
+<table class="function">
+ <tr><th colspan="2">Functions and Procedures</th></tr>
+
+ <tr>
+<td><pre>
+Fl_XPM_Image(const char *filename);
+</pre></td>
+<td><pre>
+function Create
+ (Filename : in String)
+ return XPM_Image;
+</pre></td>
+ </tr>
+
+</table>
+
+
+ </body>
+</html>
+
diff --git a/doc/index.html b/doc/index.html
index 1993a9a..057f763 100644
--- a/doc/index.html
+++ b/doc/index.html
@@ -30,7 +30,7 @@
<li><a href="fl_chart.html">Fl_Chart</a></li>
<li>Fl_Check_Browser</li>
<li><a href="fl_check_button.html">Fl_Check_Button</a></li>
- <li>Fl_Choice</li>
+ <li><a href="fl_choice.html">Fl_Choice</a></li>
<li><a href="fl_clock.html">Fl_Clock</a></li>
<li><a href="fl_clock_output.html">Fl_Clock_Output</a></li>
<li><a href="fl_color_chooser.html">Fl_Color_Chooser</a></li>
@@ -46,7 +46,7 @@
<li><a href="fl_fill_dial.html">Fl_Fill_Dial</a></li>
<li><a href="fl_fill_slider.html">Fl_Fill_Slider</a></li>
<li><a href="fl_float_input.html">Fl_Float_Input</a></li>
- <li>Fl_GIF_Image</li>
+ <li><a href="fl_gif_image.html">Fl_GIF_Image</a></li>
<li>Fl_Gl_Window</li>
<li>Fl_Glut_Window</li>
<li><a href="fl_graphics_driver.html">Fl_Graphics_Driver</a></li>
@@ -81,7 +81,7 @@
<li>Fl_Overlay_Window</li>
<li><a href="fl_pack.html">Fl_Pack</a></li>
<li><a href="fl_paged_device.html">Fl_Paged_Device</a></li>
- <li>Fl_Pixmap</li>
+ <li><a href="fl_pixmap.html">Fl_Pixmap</a></li>
<li><a href="fl_png_image.html">Fl_PNG_Image</a></li>
<li><a href="fl_pnm_image.html">Fl_PNM_Image</a></li>
<li><a href="fl_preferences.html">Fl_Preferences</a></li>
@@ -125,7 +125,7 @@
<li><a href="fl_window.html">Fl_Window</a></li>
<li><a href="fl_wizard.html">Fl_Wizard</a></li>
<li><a href="fl_xbm_image.html">Fl_XBM_Image</a></li>
- <li>Fl_XPM_Image</li>
+ <li><a href="fl_xpm_image.html">Fl_XPM_Image</a></li>
</ul>
@@ -146,6 +146,9 @@
<li><a href="fl_image.html">FLTK.Images</a></li>
<li><a href="fl_bitmap.html">FLTK.Images.Bitmaps</a></li>
<li><a href="fl_xbm_image.html">FLTK.Images.Bitmaps.XBM</a></li>
+ <li><a href="fl_pixmap.html">FLTK.Images.Pixmaps</a></li>
+ <li><a href="fl_gif_image.html">FLTK.Images.Pixmaps.GIF</a></li>
+ <li><a href="fl_xpm_image.html">FLTK.Images.Pixmaps.XPM</a></li>
<li><a href="fl_rgb_image.html">FLTK.Images.RGB</a></li>
<li><a href="fl_bmp_image.html">FLTK.Images.RGB.BMP</a></li>
<li><a href="fl_jpeg_image.html">FLTK.Images.RGB.JPEG</a></li>
@@ -197,6 +200,7 @@
<li><a href="fl_multiline_output.html">FLTK.Widgets.Inputs.Outputs.Multiline</a></li>
<li><a href="fl_secret_input.html">FLTK.Widgets.Inputs.Secret</a></li>
<li><a href="fl_menu_.html">FLTK.Widgets.Menus</a></li>
+ <li><a href="fl_choice.html">FLTK.Widgets.Menus.Choices</a></li>
<li><a href="fl_menu_bar.html">FLTK.Widgets.Menus.Menu_Bars</a></li>
<li><a href="fl_menu_button.html">FLTK.Widgets.Menus.Menu_Buttons</a></li>
<li><a href="fl_progress.html">FLTK.Widgets.Progress_Bars</a></li>
diff --git a/progress.txt b/progress.txt
index e487fdd..d8e62ea 100644
--- a/progress.txt
+++ b/progress.txt
@@ -23,6 +23,9 @@ FLTK.Event
FLTK.Images
FLTK.Images.Bitmaps
FLTK.Images.Bitmaps.XBM
+FLTK.Images.Pixmaps
+FLTK.Images.Pixmaps.GIF
+FLTK.Images.Pixmaps.XPM
FLTK.Images.RGB
FLTK.Images.RGB.BMP
FLTK.Images.RGB.JPEG
@@ -74,6 +77,7 @@ FLTK.Widgets.Inputs.Outputs
FLTK.Widgets.Inputs.Outputs.Multiline
FLTK.Widgets.Inputs.Secret
FLTK.Widgets.Menus
+FLTK.Widgets.Menus.Choices
FLTK.Widgets.Menus.Menu_Bars
FLTK.Widgets.Menus.Menu_Buttons
FLTK.Widgets.Progress_Bars
@@ -116,27 +120,24 @@ FLTK.Environment (incomplete API, otherwise polished)
To-Do:
-FL_Pixmap
-FL_GIF_Image
-FL_XPM_Image
-FL_Tiled_Image
-FL_Browser
-FL_Check_Browser
-FL_File_Browser
-FL_Hold_Browser
-FL_Multi_Browser
-FL_Select_Browser
-FL_Help_View
-FL_Table
-FL_Table_Row
-FL_Tree
-FL_Label
-FL_Postscript_File_Device
-FL_Postscript_Printer
-FL_Overlay_Window
-FL_GL_Window
-FL_Glut_Window
-FL_Cairo_Window
+Fl_Tiled_Image
+Fl_Browser
+Fl_Check_Browser
+Fl_File_Browser
+Fl_Hold_Browser
+Fl_Multi_Browser
+Fl_Select_Browser
+Fl_Help_View
+Fl_Table
+Fl_Table_Row
+Fl_Tree
+Fl_Label
+Fl_Postscript_File_Device
+Fl_Postscript_Printer
+Fl_Overlay_Window
+Fl_GL_Window
+Fl_Glut_Window
+Fl_Cairo_Window
Fl_Display_Device
Fl_File_Chooser
diff --git a/src/c_fl_choice.cpp b/src/c_fl_choice.cpp
new file mode 100644
index 0000000..f45ceed
--- /dev/null
+++ b/src/c_fl_choice.cpp
@@ -0,0 +1,85 @@
+
+
+#include <FL/Fl_Choice.H>
+#include "c_fl_choice.h"
+#include "c_fl_type.h"
+
+
+
+
+class My_Choice : public Fl_Choice {
+ public:
+ using Fl_Choice::Fl_Choice;
+ friend void choice_set_draw_hook(CHOICE n, void * d);
+ friend void fl_choice_draw(CHOICE n);
+ friend void choice_set_handle_hook(CHOICE n, void * h);
+ friend int fl_choice_handle(CHOICE n, int e);
+ protected:
+ void draw();
+ void real_draw();
+ int handle(int e);
+ int real_handle(int e);
+ d_hook_p draw_hook;
+ h_hook_p handle_hook;
+};
+
+void My_Choice::draw() {
+ (*draw_hook)(this->user_data());
+}
+
+void My_Choice::real_draw() {
+ Fl_Choice::draw();
+}
+
+int My_Choice::handle(int e) {
+ return (*handle_hook)(this->user_data(), e);
+}
+
+int My_Choice::real_handle(int e) {
+ return Fl_Choice::handle(e);
+}
+
+void choice_set_draw_hook(CHOICE n, void * d) {
+ reinterpret_cast<My_Choice*>(n)->draw_hook = reinterpret_cast<d_hook_p>(d);
+}
+
+void fl_choice_draw(CHOICE n) {
+ reinterpret_cast<My_Choice*>(n)->real_draw();
+}
+
+void choice_set_handle_hook(CHOICE n, void * h) {
+ reinterpret_cast<My_Choice*>(n)->handle_hook = reinterpret_cast<h_hook_p>(h);
+}
+
+int fl_choice_handle(CHOICE n, int e) {
+ return reinterpret_cast<My_Choice*>(n)->real_handle(e);
+}
+
+
+
+
+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 reinterpret_cast<My_Choice*>(b);
+}
+
+
+
+
+int fl_choice_value(CHOICE c) {
+ return reinterpret_cast<Fl_Choice*>(c)->value();
+}
+
+int fl_choice_set_value(CHOICE c, int p) {
+ return reinterpret_cast<Fl_Choice*>(c)->value(p);
+}
+
+int fl_choice_set_value2(CHOICE c, void * i) {
+ return reinterpret_cast<Fl_Choice*>(c)->value(reinterpret_cast<Fl_Menu_Item*>(i));
+}
+
+
diff --git a/src/c_fl_choice.h b/src/c_fl_choice.h
new file mode 100644
index 0000000..05515bb
--- /dev/null
+++ b/src/c_fl_choice.h
@@ -0,0 +1,34 @@
+
+
+#ifndef FL_CHOICE_GUARD
+#define FL_CHOICE_GUARD
+
+
+
+
+typedef void* CHOICE;
+
+
+
+
+extern "C" void choice_set_draw_hook(CHOICE n, void * d);
+extern "C" void fl_choice_draw(CHOICE n);
+extern "C" void choice_set_handle_hook(CHOICE n, void * h);
+extern "C" int fl_choice_handle(CHOICE n, int e);
+
+
+
+
+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, int p);
+extern "C" int fl_choice_set_value2(CHOICE c, void * i);
+
+
+#endif
+
diff --git a/src/c_fl_gif_image.cpp b/src/c_fl_gif_image.cpp
new file mode 100644
index 0000000..ad923bd
--- /dev/null
+++ b/src/c_fl_gif_image.cpp
@@ -0,0 +1,17 @@
+
+
+#include <FL/Fl_GIF_Image.H>
+#include "c_fl_gif_image.h"
+
+
+
+
+GIF_IMAGE new_fl_gif_image(const char * f) {
+ Fl_GIF_Image *j = new Fl_GIF_Image(f);
+ return j;
+}
+
+void free_fl_gif_image(GIF_IMAGE j) {
+ delete reinterpret_cast<Fl_GIF_Image*>(j);
+}
+
diff --git a/src/c_fl_gif_image.h b/src/c_fl_gif_image.h
new file mode 100644
index 0000000..c193ca0
--- /dev/null
+++ b/src/c_fl_gif_image.h
@@ -0,0 +1,19 @@
+
+
+#ifndef FL_GIF_IMAGE_GUARD
+#define FL_GIF_IMAGE_GUARD
+
+
+
+
+typedef void* GIF_IMAGE;
+
+
+
+
+extern "C" GIF_IMAGE new_fl_gif_image(const char * f);
+extern "C" void free_fl_gif_image(GIF_IMAGE j);
+
+
+#endif
+
diff --git a/src/c_fl_menu.cpp b/src/c_fl_menu.cpp
index 411efde..3a4fa8f 100644
--- a/src/c_fl_menu.cpp
+++ b/src/c_fl_menu.cpp
@@ -125,6 +125,14 @@ int fl_menu_value(MENU m) {
return reinterpret_cast<Fl_Menu_*>(m)->value();
}
+int fl_menu_set_value(MENU m, int p) {
+ return reinterpret_cast<Fl_Menu_*>(m)->value(p);
+}
+
+int fl_menu_set_value2(MENU m, void * i) {
+ return reinterpret_cast<Fl_Menu_*>(m)->value(reinterpret_cast<Fl_Menu_Item*>(i));
+}
+
diff --git a/src/c_fl_menu.h b/src/c_fl_menu.h
index 79f64a8..7babca2 100644
--- a/src/c_fl_menu.h
+++ b/src/c_fl_menu.h
@@ -41,6 +41,8 @@ extern "C" int fl_menu_size(MENU m);
extern "C" const void * fl_menu_mvalue(MENU m);
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, int p);
+extern "C" int fl_menu_set_value2(MENU m, void * i);
extern "C" unsigned int fl_menu_get_textcolor(MENU m);
diff --git a/src/c_fl_pixmap.cpp b/src/c_fl_pixmap.cpp
new file mode 100644
index 0000000..18e6b5d
--- /dev/null
+++ b/src/c_fl_pixmap.cpp
@@ -0,0 +1,44 @@
+
+
+#include <FL/Fl_Pixmap.H>
+#include "c_fl_pixmap.h"
+
+
+
+
+void free_fl_pixmap(PIXMAP b) {
+ delete reinterpret_cast<Fl_Pixmap*>(b);
+}
+
+PIXMAP fl_pixmap_copy(PIXMAP b, int w, int h) {
+ return reinterpret_cast<Fl_Pixmap*>(b)->Fl_Pixmap::copy(w, h);
+}
+
+PIXMAP fl_pixmap_copy2(PIXMAP b) {
+ return reinterpret_cast<Fl_Pixmap*>(b)->copy();
+}
+
+
+
+
+void fl_pixmap_color_average(PIXMAP p, int c, float b) {
+ // virtual so disable dispatch
+ reinterpret_cast<Fl_Pixmap*>(p)->Fl_Pixmap::color_average(c, b);
+}
+
+void fl_pixmap_desaturate(PIXMAP p) {
+ // virtual so disable dispatch
+ reinterpret_cast<Fl_Pixmap*>(p)->Fl_Pixmap::desaturate();
+}
+
+
+
+
+void fl_pixmap_draw2(PIXMAP b, int x, int y) {
+ reinterpret_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) {
+ reinterpret_cast<Fl_Pixmap*>(b)->Fl_Pixmap::draw(x, y, w, h, cx, cy);
+}
+
diff --git a/src/c_fl_pixmap.h b/src/c_fl_pixmap.h
new file mode 100644
index 0000000..de987a8
--- /dev/null
+++ b/src/c_fl_pixmap.h
@@ -0,0 +1,28 @@
+
+
+#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_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/src/c_fl_xpm_image.cpp b/src/c_fl_xpm_image.cpp
new file mode 100644
index 0000000..dae1c12
--- /dev/null
+++ b/src/c_fl_xpm_image.cpp
@@ -0,0 +1,17 @@
+
+
+#include <FL/Fl_XPM_Image.H>
+#include "c_fl_xpm_image.h"
+
+
+
+
+XPM_IMAGE new_fl_xpm_image(const char * f) {
+ Fl_XPM_Image *j = new Fl_XPM_Image(f);
+ return j;
+}
+
+void free_fl_xpm_image(XPM_IMAGE j) {
+ delete reinterpret_cast<Fl_XPM_Image*>(j);
+}
+
diff --git a/src/c_fl_xpm_image.h b/src/c_fl_xpm_image.h
new file mode 100644
index 0000000..3d01e61
--- /dev/null
+++ b/src/c_fl_xpm_image.h
@@ -0,0 +1,19 @@
+
+
+#ifndef FL_XPM_IMAGE_GUARD
+#define FL_XPM_IMAGE_GUARD
+
+
+
+
+typedef void* XPM_IMAGE;
+
+
+
+
+extern "C" XPM_IMAGE new_fl_xpm_image(const char * f);
+extern "C" void free_fl_xpm_image(XPM_IMAGE j);
+
+
+#endif
+
diff --git a/src/fltk-images-pixmaps-gif.adb b/src/fltk-images-pixmaps-gif.adb
new file mode 100644
index 0000000..579d8b7
--- /dev/null
+++ b/src/fltk-images-pixmaps-gif.adb
@@ -0,0 +1,71 @@
+
+
+with
+
+ Interfaces.C,
+ System;
+
+use type
+
+ System.Address;
+
+
+package body FLTK.Images.Pixmaps.GIF is
+
+
+ function new_fl_gif_image
+ (F : in Interfaces.C.char_array)
+ return System.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 System.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 /= System.Null_Address and then
+ This in GIF_Image'Class
+ then
+ free_fl_gif_image (This.Void_Ptr);
+ This.Void_Ptr := System.Null_Address;
+ end if;
+ Finalize (Pixmap (This));
+ end Finalize;
+
+
+
+
+ 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/src/fltk-images-pixmaps-gif.ads b/src/fltk-images-pixmaps-gif.ads
new file mode 100644
index 0000000..18e31b9
--- /dev/null
+++ b/src/fltk-images-pixmaps-gif.ads
@@ -0,0 +1,33 @@
+
+
+package FLTK.Images.Pixmaps.GIF is
+
+
+ type GIF_Image is new Pixmap with private;
+
+ type GIF_Image_Reference (Data : not null access GIF_Image'Class) is
+ limited null record with Implicit_Dereference => Data;
+
+
+
+
+ package Forge is
+
+ function Create
+ (Filename : in String)
+ return GIF_Image;
+
+ end Forge;
+
+
+private
+
+
+ type GIF_Image is new Pixmap with null record;
+
+ overriding procedure Finalize
+ (This : in out GIF_Image);
+
+
+end FLTK.Images.Pixmaps.GIF;
+
diff --git a/src/fltk-images-pixmaps-xpm.adb b/src/fltk-images-pixmaps-xpm.adb
new file mode 100644
index 0000000..36c4180
--- /dev/null
+++ b/src/fltk-images-pixmaps-xpm.adb
@@ -0,0 +1,71 @@
+
+
+with
+
+ Interfaces.C,
+ System;
+
+use type
+
+ System.Address;
+
+
+package body FLTK.Images.Pixmaps.XPM is
+
+
+ function new_fl_xpm_image
+ (F : in Interfaces.C.char_array)
+ return System.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 System.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 /= System.Null_Address and then
+ This in XPM_Image'Class
+ then
+ free_fl_xpm_image (This.Void_Ptr);
+ This.Void_Ptr := System.Null_Address;
+ end if;
+ Finalize (Pixmap (This));
+ end Finalize;
+
+
+
+
+ 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/src/fltk-images-pixmaps-xpm.ads b/src/fltk-images-pixmaps-xpm.ads
new file mode 100644
index 0000000..e888632
--- /dev/null
+++ b/src/fltk-images-pixmaps-xpm.ads
@@ -0,0 +1,33 @@
+
+
+package FLTK.Images.Pixmaps.XPM is
+
+
+ type XPM_Image is new Pixmap with private;
+
+ type XPM_Image_Reference (Data : not null access XPM_Image'Class) is
+ limited null record with Implicit_Dereference => Data;
+
+
+
+
+ package Forge is
+
+ function Create
+ (Filename : in String)
+ return XPM_Image;
+
+ end Forge;
+
+
+private
+
+
+ type XPM_Image is new Pixmap with null record;
+
+ overriding procedure Finalize
+ (This : in out XPM_Image);
+
+
+end FLTK.Images.Pixmaps.XPM;
+
diff --git a/src/fltk-images-pixmaps.adb b/src/fltk-images-pixmaps.adb
new file mode 100644
index 0000000..dc77d24
--- /dev/null
+++ b/src/fltk-images-pixmaps.adb
@@ -0,0 +1,157 @@
+
+
+with
+
+ Interfaces.C,
+ System;
+
+use type
+
+ System.Address;
+
+
+package body FLTK.Images.Pixmaps is
+
+
+ procedure free_fl_pixmap
+ (I : in System.Address);
+ pragma Import (C, free_fl_pixmap, "free_fl_pixmap");
+ pragma Inline (free_fl_pixmap);
+
+ function fl_pixmap_copy
+ (I : in System.Address;
+ W, H : in Interfaces.C.int)
+ return System.Address;
+ pragma Import (C, fl_pixmap_copy, "fl_pixmap_copy");
+ pragma Inline (fl_pixmap_copy);
+
+ function fl_pixmap_copy2
+ (I : in System.Address)
+ return System.Address;
+ pragma Import (C, fl_pixmap_copy2, "fl_pixmap_copy2");
+ pragma Inline (fl_pixmap_copy2);
+
+
+
+
+ procedure fl_pixmap_color_average
+ (I : in System.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 System.Address);
+ pragma Import (C, fl_pixmap_desaturate, "fl_pixmap_desaturate");
+ pragma Inline (fl_pixmap_desaturate);
+
+
+
+
+ procedure fl_pixmap_draw2
+ (I : in System.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 System.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 /= System.Null_Address and then
+ This in Pixmap'Class
+ then
+ free_fl_pixmap (This.Void_Ptr);
+ This.Void_Ptr := System.Null_Address;
+ end if;
+ Finalize (Image (This));
+ end Finalize;
+
+
+
+
+ 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;
+
+
+
+
+ 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;
+
+
+
+
+ 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/src/fltk-images-pixmaps.ads b/src/fltk-images-pixmaps.ads
new file mode 100644
index 0000000..b72c382
--- /dev/null
+++ b/src/fltk-images-pixmaps.ads
@@ -0,0 +1,67 @@
+
+
+package FLTK.Images.Pixmaps is
+
+
+ type Pixmap is new Image with private;
+
+ type Pixmap_Reference (Data : not null access Pixmap'Class) is limited null record
+ with Implicit_Dereference => Data;
+
+
+
+
+ function Copy
+ (This : in Pixmap;
+ Width, Height : in Natural)
+ return Pixmap'Class;
+
+ function Copy
+ (This : in Pixmap)
+ return Pixmap'Class;
+
+
+
+
+ procedure Color_Average
+ (This : in out Pixmap;
+ Col : in Color;
+ Amount : in Blend);
+
+ procedure Desaturate
+ (This : in out Pixmap);
+
+
+
+
+ procedure Draw
+ (This : in Pixmap;
+ X, Y : in Integer);
+
+ procedure Draw
+ (This : in Pixmap;
+ X, Y, W, H : in Integer;
+ CX, CY : in Integer := 0);
+
+
+private
+
+
+ type Pixmap is new Image with null record;
+
+ overriding procedure Finalize
+ (This : in out Pixmap);
+
+
+
+
+ pragma Inline (Color_Average);
+ pragma Inline (Desaturate);
+
+
+ pragma Inline (Copy);
+ pragma Inline (Draw);
+
+
+end FLTK.Images.Pixmaps;
+
diff --git a/src/fltk-widgets-menus-choices.adb b/src/fltk-widgets-menus-choices.adb
new file mode 100644
index 0000000..5696bd2
--- /dev/null
+++ b/src/fltk-widgets-menus-choices.adb
@@ -0,0 +1,182 @@
+
+
+with
+
+ Interfaces.C,
+ System;
+
+use type
+
+ Interfaces.C.int,
+ System.Address;
+
+
+package body FLTK.Widgets.Menus.Choices is
+
+
+ procedure choice_set_draw_hook
+ (W, D : in System.Address);
+ pragma Import (C, choice_set_draw_hook, "choice_set_draw_hook");
+ pragma Inline (choice_set_draw_hook);
+
+ procedure choice_set_handle_hook
+ (W, H : in System.Address);
+ pragma Import (C, choice_set_handle_hook, "choice_set_handle_hook");
+ pragma Inline (choice_set_handle_hook);
+
+
+
+
+ function new_fl_choice
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return System.Address;
+ pragma Import (C, new_fl_choice, "new_fl_choice");
+ pragma Inline (new_fl_choice);
+
+ procedure free_fl_choice
+ (B : in System.Address);
+ pragma Import (C, free_fl_choice, "free_fl_choice");
+ pragma Inline (free_fl_choice);
+
+
+
+
+ function fl_choice_value
+ (M : in System.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 : in System.Address;
+ I : in Interfaces.C.int)
+ 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, I : in System.Address)
+ 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 System.Address);
+ pragma Import (C, fl_choice_draw, "fl_choice_draw");
+ pragma Inline (fl_choice_draw);
+
+ function fl_choice_handle
+ (W : in System.Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_choice_handle, "fl_choice_handle");
+ pragma Inline (fl_choice_handle);
+
+
+
+
+ procedure Finalize
+ (This : in out Choice) is
+ begin
+ if This.Void_Ptr /= System.Null_Address and then
+ This in Choice'Class
+ then
+ if This.Needs_Dealloc then
+ free_fl_choice (This.Void_Ptr);
+ end if;
+ This.Void_Ptr := System.Null_Address;
+ end if;
+ Finalize (Widget (This));
+ end Finalize;
+
+
+
+
+ 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));
+ fl_widget_set_user_data
+ (This.Void_Ptr,
+ Widget_Convert.To_Address (This'Unchecked_Access));
+ choice_set_draw_hook (This.Void_Ptr, Draw_Hook'Address);
+ choice_set_handle_hook (This.Void_Ptr, Handle_Hook'Address);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ function Chosen
+ (This : in Choice)
+ return FLTK.Menu_Items.Menu_Item_Reference is
+ begin
+ return (Data => This.My_Items.Element (This.Chosen_Index));
+ end Chosen;
+
+
+ function Chosen_Index
+ (This : in Choice)
+ return Extended_Index is
+ begin
+ return Extended_Index (fl_choice_value (This.Void_Ptr) + 1);
+ end Chosen_Index;
+
+
+ procedure Set_Chosen
+ (This : in out Choice;
+ Place : in Index)
+ is
+ Ignore_Ret : Interfaces.C.int;
+ begin
+ Ignore_Ret := fl_choice_set_value (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+ end Set_Chosen;
+
+
+ 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_value2 (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+ end Set_Chosen;
+
+
+
+
+ procedure Draw
+ (This : in out Choice) is
+ begin
+ fl_choice_draw (This.Void_Ptr);
+ end Draw;
+
+
+ function Handle
+ (This : in out Choice;
+ Event : in Event_Kind)
+ return Event_Outcome is
+ begin
+ return Event_Outcome'Val
+ (fl_choice_handle (This.Void_Ptr, Event_Kind'Pos (Event)));
+ end Handle;
+
+
+end FLTK.Widgets.Menus.Choices;
+
diff --git a/src/fltk-widgets-menus-choices.ads b/src/fltk-widgets-menus-choices.ads
new file mode 100644
index 0000000..7f99852
--- /dev/null
+++ b/src/fltk-widgets-menus-choices.ads
@@ -0,0 +1,75 @@
+
+
+package FLTK.Widgets.Menus.Choices is
+
+
+ type Choice is new Menu with private;
+
+ type Choice_Reference (Data : not null access Choice'Class) is limited null record
+ with Implicit_Dereference => Data;
+
+
+
+
+ package Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String)
+ return Choice;
+
+ end Forge;
+
+
+
+
+ function Chosen
+ (This : in Choice)
+ return FLTK.Menu_Items.Menu_Item_Reference;
+
+ function Chosen_Index
+ (This : in Choice)
+ return Extended_Index;
+
+ procedure Set_Chosen
+ (This : in out Choice;
+ Place : in Index);
+
+ procedure Set_Chosen
+ (This : in out Choice;
+ Item : in FLTK.Menu_Items.Menu_Item);
+
+
+
+
+ procedure Draw
+ (This : in out Choice);
+
+ function Handle
+ (This : in out Choice;
+ Event : in Event_Kind)
+ return Event_Outcome;
+
+
+private
+
+
+ type Choice is new Menu with null record;
+
+ overriding procedure Finalize
+ (This : in out Choice);
+
+
+
+
+ pragma Inline (Chosen);
+ pragma Inline (Chosen_Index);
+ pragma Inline (Set_Chosen);
+
+
+ pragma Inline (Draw);
+ pragma Inline (Handle);
+
+
+end FLTK.Widgets.Menus.Choices;
+
diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb
index 03333d2..0b652cf 100644
--- a/src/fltk-widgets-menus.adb
+++ b/src/fltk-widgets-menus.adb
@@ -146,6 +146,19 @@ package body FLTK.Widgets.Menus is
pragma Import (C, fl_menu_value, "fl_menu_value");
pragma Inline (fl_menu_value);
+ function fl_menu_set_value
+ (M : in System.Address;
+ I : in Interfaces.C.int)
+ 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, I : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_set_value2, "fl_menu_set_value2");
+ pragma Inline (fl_menu_set_value2);
+
@@ -583,6 +596,26 @@ package body FLTK.Widgets.Menus is
end Chosen_Index;
+ procedure Set_Chosen
+ (This : in out Menu;
+ Place : in Index)
+ is
+ Ignore_Ret : Interfaces.C.int;
+ begin
+ Ignore_Ret := fl_menu_set_value (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+ end Set_Chosen;
+
+
+ procedure Set_Chosen
+ (This : in out Menu;
+ Item : in FLTK.Menu_Items.Menu_Item)
+ is
+ Ignore_Ret : Interfaces.C.int;
+ begin
+ Ignore_Ret := fl_menu_set_value2 (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+ end Set_Chosen;
+
+
function Get_Text_Color
diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads
index 95e4528..f756109 100644
--- a/src/fltk-widgets-menus.ads
+++ b/src/fltk-widgets-menus.ads
@@ -142,6 +142,14 @@ package FLTK.Widgets.Menus is
(This : in Menu)
return Extended_Index;
+ procedure Set_Chosen
+ (This : in out Menu;
+ Place : in Index);
+
+ procedure Set_Chosen
+ (This : in out Menu;
+ Item : in FLTK.Menu_Items.Menu_Item);
+
@@ -294,6 +302,7 @@ private
pragma Inline (Chosen);
pragma Inline (Chosen_Label);
pragma Inline (Chosen_Index);
+ pragma Inline (Set_Chosen);
pragma Inline (Get_Text_Color);