From 2cbec01126c34e70fc8e11d77553ef5bfd94cec7 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 18 May 2018 16:21:25 +1000 Subject: Added Choices, Pixmaps, GIFs, XPMs --- doc/fl_choice.html | 130 ++++++++++++++++++++++++++ doc/fl_gif_image.html | 65 +++++++++++++ doc/fl_menu_.html | 12 ++- doc/fl_pixmap.html | 153 +++++++++++++++++++++++++++++++ doc/fl_xpm_image.html | 65 +++++++++++++ doc/index.html | 12 ++- progress.txt | 43 ++++----- src/c_fl_choice.cpp | 85 +++++++++++++++++ src/c_fl_choice.h | 34 +++++++ src/c_fl_gif_image.cpp | 17 ++++ src/c_fl_gif_image.h | 19 ++++ src/c_fl_menu.cpp | 8 ++ src/c_fl_menu.h | 2 + src/c_fl_pixmap.cpp | 44 +++++++++ src/c_fl_pixmap.h | 28 ++++++ src/c_fl_xpm_image.cpp | 17 ++++ src/c_fl_xpm_image.h | 19 ++++ src/fltk-images-pixmaps-gif.adb | 71 +++++++++++++++ src/fltk-images-pixmaps-gif.ads | 33 +++++++ src/fltk-images-pixmaps-xpm.adb | 71 +++++++++++++++ src/fltk-images-pixmaps-xpm.ads | 33 +++++++ src/fltk-images-pixmaps.adb | 157 ++++++++++++++++++++++++++++++++ src/fltk-images-pixmaps.ads | 67 ++++++++++++++ src/fltk-widgets-menus-choices.adb | 182 +++++++++++++++++++++++++++++++++++++ src/fltk-widgets-menus-choices.ads | 75 +++++++++++++++ src/fltk-widgets-menus.adb | 33 +++++++ src/fltk-widgets-menus.ads | 9 ++ 27 files changed, 1457 insertions(+), 27 deletions(-) create mode 100644 doc/fl_choice.html create mode 100644 doc/fl_gif_image.html create mode 100644 doc/fl_pixmap.html create mode 100644 doc/fl_xpm_image.html create mode 100644 src/c_fl_choice.cpp create mode 100644 src/c_fl_choice.h create mode 100644 src/c_fl_gif_image.cpp create mode 100644 src/c_fl_gif_image.h create mode 100644 src/c_fl_pixmap.cpp create mode 100644 src/c_fl_pixmap.h create mode 100644 src/c_fl_xpm_image.cpp create mode 100644 src/c_fl_xpm_image.h create mode 100644 src/fltk-images-pixmaps-gif.adb create mode 100644 src/fltk-images-pixmaps-gif.ads create mode 100644 src/fltk-images-pixmaps-xpm.adb create mode 100644 src/fltk-images-pixmaps-xpm.ads create mode 100644 src/fltk-images-pixmaps.adb create mode 100644 src/fltk-images-pixmaps.ads create mode 100644 src/fltk-widgets-menus-choices.adb create mode 100644 src/fltk-widgets-menus-choices.ads 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 @@ + + + + + + + Fl_Choice Binding Map + + + + + + +

Fl_Choice Binding Map

+ + + + + + + + + + +
Package name
Fl_ChoiceFLTK.Widgets.Menus.Choices
+ + + + + + + + + + + + + + + + +
Types
Fl_ChoiceChoice
 Choice_Reference
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Functions and Procedures
+Fl_Choice(int X, int Y, int W, int H, const char *L=0);
+
+function Create
+       (X, Y, W, H : in Integer;
+        Text       : in String)
+    return Choice;
+
+void draw();
+
+procedure Draw
+       (This : in out Choice);
+
+int handle(int);
+
+function Handle
+       (This  : in out Choice;
+        Event : in     Event_Kind)
+    return Event_Outcome;
+
 
+function Chosen
+       (This : in Choice)
+    return FLTK.Menu_Items.Menu_Item_Reference;
+
+int value() const;
+
+function Chosen_Index
+       (This : in Choice)
+    return Extended_Index;
+
+int value(int v);
+
+procedure Set_Chosen
+       (This  : in out Choice;
+        Place : in     Index);
+
+int value(const Fl_Menu_Item *v);
+
+procedure Set_Chosen
+       (This : in out Choice;
+        Item : in     FLTK.Menu_Items.Menu_Item);
+
+ + + + + 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 @@ + + + + + + + Fl_GIF_Image Binding Map + + + + + + +

Fl_GIF_Image Binding Map

+ + + + + + + + + + +
Package name
Fl_GIF_ImageFLTK.Images.Pixmaps.GIF
+ + + + + + + + + + + + + + + + +
Types
Fl_GIF_ImageGIF_Image
 GIF_Image_Reference
+ + + + + + + + + + + +
Functions and Procedures
+Fl_GIF_Image(const char *filename);
+
+function Create
+       (Filename : in String)
+    return GIF_Image;
+
+ + + + + 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 
 int value(const Fl_Menu_Item *);
-  +
+procedure Set_Chosen
+       (This : in out Menu;
+        Item : in     FLTK.Menu_Items.Menu_Item);
+
 int value(int i);
-  +
+procedure Set_Chosen
+       (This  : in out Menu;
+        Place : in     Index);
+
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 @@ + + + + + + + Fl_Pixmap Binding Map + + + + + + +

Fl_Pixmap Binding Map

+ + + + + + + + + + +
Package name
Fl_PixmapFLTK.Images.Pixmaps
+ + + + + + + + + + + + + + + + +
Types
Fl_PixmapPixmap
 Pixmap_Reference
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Functions and Procedures
+Fl_Pixmap(char *const *D);
+Fl_Pixmap(uchar *const *D);
+Fl_Pixmap(const char *const *D);
+Fl_Pixmap(const uchar *const *D);
+
 
+virtual void color_average(Fl_Color c, float i);
+
+procedure Color_Average
+       (This   : in out Pixmap;
+        Col    : in     Color;
+        Amount : in     Blend);
+
+virtual Fl_Image * copy(int W, int H);
+
+function Copy
+       (This          : in Pixmap;
+        Width, Height : in Natural)
+    return Pixmap'Class;
+
+Fl_Image * copy();
+
+function Copy
+       (This : in Pixmap)
+    return Pixmap'Class;
+
+virtual void desaturate();
+
+procedure Desaturate
+       (This : in out Pixmap);
+
+virtual void draw(int X, int Y, int W, int H, int cx=0, int cy=0);
+
+procedure Draw
+       (This       : in Pixmap;
+        X, Y, W, H : in Integer;
+        CX, CY     : in Integer := 0);
+
+void draw(int X, int Y);
+
+procedure Draw
+       (This : in Pixmap;
+        X, Y : in Integer);
+
+virtual void label(Fl_Widget *w);
+
 
+virtual void label(Fl_Menu_Item *m);
+
 
+virtual void uncache();
+
 
+ + + + + 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 @@ + + + + + + + Fl_XPM_Image Binding Map + + + + + + +

Fl_XPM_Image Binding Map

+ + + + + + + + + + +
Package name
Fl_XPM_ImageFLTK.Images.Pixmaps.XPM
+ + + + + + + + + + + + + + + + +
Types
Fl_XPM_ImageXPM_Image
 XPM_Image_Reference
+ + + + + + + + + + + +
Functions and Procedures
+Fl_XPM_Image(const char *filename);
+
+function Create
+       (Filename : in String)
+    return XPM_Image;
+
+ + + + + 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 @@
  • Fl_Chart
  • Fl_Check_Browser
  • Fl_Check_Button
    • -
  • Fl_Choice
    • +
  • Fl_Choice
  • Fl_Clock
  • Fl_Clock_Output
  • Fl_Color_Chooser
    • @@ -46,7 +46,7 @@
  • Fl_Fill_Dial
  • Fl_Fill_Slider
  • Fl_Float_Input
    • -
  • Fl_GIF_Image
    • +
  • Fl_GIF_Image
  • Fl_Gl_Window
  • Fl_Glut_Window
  • Fl_Graphics_Driver
    • @@ -81,7 +81,7 @@
  • Fl_Overlay_Window
  • Fl_Pack
  • Fl_Paged_Device
    • -
  • Fl_Pixmap
    • +
  • Fl_Pixmap
  • Fl_PNG_Image
  • Fl_PNM_Image
  • Fl_Preferences
    • @@ -125,7 +125,7 @@
  • Fl_Window
  • Fl_Wizard
  • Fl_XBM_Image
    • -
  • Fl_XPM_Image
    • +
  • Fl_XPM_Image
    • @@ -146,6 +146,9 @@
  • 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
    • @@ -197,6 +200,7 @@
  • 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
    • 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 +#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(n)->draw_hook = reinterpret_cast(d); +} + +void fl_choice_draw(CHOICE n) { + reinterpret_cast(n)->real_draw(); +} + +void choice_set_handle_hook(CHOICE n, void * h) { + reinterpret_cast(n)->handle_hook = reinterpret_cast(h); +} + +int fl_choice_handle(CHOICE n, int e) { + return reinterpret_cast(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(b); +} + + + + +int fl_choice_value(CHOICE c) { + return reinterpret_cast(c)->value(); +} + +int fl_choice_set_value(CHOICE c, int p) { + return reinterpret_cast(c)->value(p); +} + +int fl_choice_set_value2(CHOICE c, void * i) { + return reinterpret_cast(c)->value(reinterpret_cast(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 +#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(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(m)->value(); } +int fl_menu_set_value(MENU m, int p) { + return reinterpret_cast(m)->value(p); +} + +int fl_menu_set_value2(MENU m, void * i) { + return reinterpret_cast(m)->value(reinterpret_cast(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 +#include "c_fl_pixmap.h" + + + + +void free_fl_pixmap(PIXMAP b) { + delete reinterpret_cast(b); +} + +PIXMAP fl_pixmap_copy(PIXMAP b, int w, int h) { + return reinterpret_cast(b)->Fl_Pixmap::copy(w, h); +} + +PIXMAP fl_pixmap_copy2(PIXMAP b) { + return reinterpret_cast(b)->copy(); +} + + + + +void fl_pixmap_color_average(PIXMAP p, int c, float b) { + // virtual so disable dispatch + reinterpret_cast(p)->Fl_Pixmap::color_average(c, b); +} + +void fl_pixmap_desaturate(PIXMAP p) { + // virtual so disable dispatch + reinterpret_cast(p)->Fl_Pixmap::desaturate(); +} + + + + +void fl_pixmap_draw2(PIXMAP b, int x, int y) { + reinterpret_cast(b)->draw(x, y); +} + +void fl_pixmap_draw(PIXMAP b, int x, int y, int w, int h, int cx, int cy) { + reinterpret_cast(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 +#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(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); -- cgit