summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-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
20 files changed, 1004 insertions, 0 deletions
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);
generated by cgit (git 2.30.0) at 2024-12-22 19:20:56 +0000