diff options
| -rw-r--r-- | doc/fl_positioner.html | 339 | ||||
| -rw-r--r-- | doc/index.html | 2 | ||||
| -rw-r--r-- | progress.txt | 3 | ||||
| -rw-r--r-- | src/c_fl_positioner.cpp | 166 | ||||
| -rw-r--r-- | src/c_fl_positioner.h | 49 | ||||
| -rw-r--r-- | src/fltk-widgets-positioners.adb | 525 | ||||
| -rw-r--r-- | src/fltk-widgets-positioners.ads | 194 |
7 files changed, 1277 insertions, 1 deletions
diff --git a/doc/fl_positioner.html b/doc/fl_positioner.html new file mode 100644 index 0000000..c38536c --- /dev/null +++ b/doc/fl_positioner.html @@ -0,0 +1,339 @@ +<!DOCTYPE html> + +<html lang="en"> + <head> + <meta charset="utf-8"> + <title>Fl_Positioner Binding Map</title> + <link href="map.css" rel="stylesheet"> + </head> + + <body> + + +<h2>Fl_Positioner Binding Map</h2> + + +<a href="index.html">Back to Index</a> + + +<table class="package"> + <tr><th colspan="2">Package name</th></tr> + + <tr> + <td>Fl_Positioner</td> + <td>FLTK.Widgets.Positioners</td> + </tr> + +</table> + + + +<table class="type"> + <tr><th colspan="2">Types</th></tr> + + <tr> + <td>Fl_Positioner</td> + <td>Positioner</td> + </tr> + + <tr> + <td> </td> + <td>Positioner_Reference</td> + </tr> + +</table> + + + +<table class="function"> + <tr><th colspan="2">Constructors</th></tr> + + <tr> +<td><pre> +Fl_Positioner(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 Positioner; +</pre></td> + </tr> + +</table> + + + +<table class="function"> + <tr><th colspan="2">Functions and Procedures</th></tr> + + <tr> +<td><pre> +int handle(int); +</pre></td> +<td><pre> +function Handle + (This : in out Positioner; + Event : in Event_Kind) + return Event_Outcome; +</pre></td> + </tr> + + <tr> +<td>Use xvalue and yvalue manually.</td> +<td><pre> +procedure Get_Coords + (This : in Positioner; + X, Y : out Long_Float); +</pre></td> + </tr> + + <tr> +<td><pre> +int value(double, double); +</pre></td> +<td><pre> +procedure Set_Coords + (This : in out Positioner; + X, Y : in Long_Float); + +function Set_Coords + (This : in out Positioner; + X, Y : in Long_Float) + return Boolean; +</pre></td> + </tr> + + <tr> +<td><pre> +void xbounds(double, double); +</pre></td> +<td><pre> +procedure Set_Ecks_Bounds + (This : in out Positioner; + Low, High : in Long_Float); +</pre></td> + </tr> + + <tr> +<td><pre> +double xmaximum() const; +</pre></td> +<td><pre> +function Get_Ecks_Maximum + (This : in Positioner) + return Long_Float; +</pre></td> + </tr> + + <tr> +<td><pre> +void xmaximum(double a); +</pre></td> +<td><pre> +procedure Set_Ecks_Maximum + (This : in out Positioner; + Value : in Long_Float); +</pre></td> + </tr> + + <tr> +<td><pre> +double xminimum() const; +</pre></td> +<td><pre> +function Get_Ecks_Minimum + (This : in Positioner) + return Long_Float; +</pre></td> + </tr> + + <tr> +<td><pre> +void xminimum(double a); +</pre></td> +<td><pre> +procedure Set_Ecks_Minimum + (This : in out Positioner; + Value : in Long_Float); +</pre></td> + </tr> + + <tr> +<td><pre> +void xstep(double a); +</pre></td> +<td><pre> +procedure Set_Ecks_Step + (This : in out Positioner; + Value : in Long_Float); +</pre></td> + </tr> + + <tr> +<td><pre> +double xvalue() const; +</pre></td> +<td><pre> +function Get_Ecks + (This : in Positioner) + return Long_Float; +</pre></td> + </tr> + + <tr> +<td><pre> +int xvalue(double); +</pre></td> +<td><pre> +procedure Set_Ecks + (This : in out Positioner; + Value : in Long_Float); + +function Set_Ecks + (This : in out Positioner; + Value : in Long_Float) + return Boolean; +</pre></td> + </tr> + + <tr> +<td><pre> +void ybounds(double, double); +</pre></td> +<td><pre> +procedure Set_Why_Bounds + (This : in out Positioner; + Low, High : in Long_Float); +</pre></td> + </tr> + + <tr> +<td><pre> +double ymaximum() const; +</pre></td> +<td><pre> +function Get_Why_Maximum + (This : in Positioner) + return Long_Float; +</pre></td> + </tr> + + <tr> +<td><pre> +void ymaximum(double a); +</pre></td> +<td><pre> +procedure Set_Why_Maximum + (This : in out Positioner; + Value : in Long_Float); +</pre></td> + </tr> + + <tr> +<td><pre> +double yminimum() const; +</pre></td> +<td><pre> +function Get_Why_Minimum + (This : in Positioner) + return Long_Float; +</pre></td> + </tr> + + <tr> +<td><pre> +void yminimum(double a); +</pre></td> +<td><pre> +procedure Set_Why_Minimum + (This : in out Positioner; + Value : in Long_Float); +</pre></td> + </tr> + + <tr> +<td><pre> +void ystep(double a); +</pre></td> +<td><pre> +procedure Set_Why_Step + (This : in out Positioner; + Value : in Long_Float); +</pre></td> + </tr> + + <tr> +<td><pre> +double yvalue() const; +</pre></td> +<td><pre> +function Get_Why + (This : in Positioner) + return Long_Float; +</pre></td> + </tr> + + <tr> +<td><pre> +int yvalue(double); +</pre></td> +<td><pre> +procedure Set_Why + (This : in out Positioner; + Value : in Long_Float); + +function Set_Why + (This : in out Positioner; + Value : in Long_Float) + return Boolean; +</pre></td> + </tr> + +</table> + + + +<table class="function"> + <tr><th colspan="2">Protected Functions and Procedures</th></tr> + + <tr> +<td><pre> +void draw(); +</pre></td> +<td><pre> +procedure Draw + (This : in out Positioner); +</pre></td> + </tr> + + <tr> +<td><pre> +void draw(int, int, int, int); +</pre></td> +<td><pre> +procedure Draw + (This : in out Positioner; + X, Y, W, H : in Integer); +</pre></td> + </tr> + + <tr> +<td><pre> +int handle(int, int, int, int, int); +</pre></td> +<td><pre> +function Handle + (This : in out Positioner; + Event : in Event_Kind; + X, Y, W, H : in Integer) + return Event_Outcome; +</pre></td> + </tr> + +</table> + + + </body> +</html> + diff --git a/doc/index.html b/doc/index.html index d181682..5c38e3a 100644 --- a/doc/index.html +++ b/doc/index.html @@ -88,6 +88,7 @@ <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_positioner.html">Fl_Positioner</a></li> <li><a href="fl_postscript_file_device.html">Fl_PostScript_File_Device</a></li> <li>Fl_PostScript_Graphics_Driver</li> <li><a href="fl_preferences.html">Fl_Preferences</a></li> @@ -233,6 +234,7 @@ <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_positioner.html">FLTK.Widgets.Positioners</a></li> <li><a href="fl_progress.html">FLTK.Widgets.Progress_Bars</a></li> <li><a href="fl_valuator.html">FLTK.Widgets.Valuators</a></li> <li><a href="fl_adjuster.html">FLTK.Widgets.Valuators.Adjusters</a></li> diff --git a/progress.txt b/progress.txt index 62b7d45..296b947 100644 --- a/progress.txt +++ b/progress.txt @@ -103,6 +103,7 @@ FLTK.Widgets.Menus FLTK.Widgets.Menus.Choices FLTK.Widgets.Menus.Menu_Bars FLTK.Widgets.Menus.Menu_Buttons +FLTK.Widgets.Positioners FLTK.Widgets.Progress_Bars FLTK.Widgets.Valuators FLTK.Widgets.Valuators.Adjusters @@ -139,7 +140,6 @@ To-Do: Fl_GDI_Graphics_Driver Fl_GDI_Printer_Graphics_Driver Fl_Glut_Window -Fl_Positioner Fl_Postscript_Graphics_Driver Fl_Quartz_Graphics_Driver Fl_Sys_Menu_Bar @@ -191,6 +191,7 @@ Bugs to fix: Fl_Wizard draw() method private/protected GNAT bug with type_invariant combined with derived type and a begin section in a package, eg dialogs.adb Fl_Bitmap / Fl_XBM_Image instances will always have fail() return ERR_NO_IMAGE +Fl_Positioner has poor docs for value/xvalue/yvalue set methods diff --git a/src/c_fl_positioner.cpp b/src/c_fl_positioner.cpp new file mode 100644 index 0000000..ce23b64 --- /dev/null +++ b/src/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/src/c_fl_positioner.h b/src/c_fl_positioner.h new file mode 100644 index 0000000..9fd96d4 --- /dev/null +++ b/src/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/src/fltk-widgets-positioners.adb b/src/fltk-widgets-positioners.adb new file mode 100644 index 0000000..0e3dfb2 --- /dev/null +++ b/src/fltk-widgets-positioners.adb @@ -0,0 +1,525 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Ada.Assertions, + 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; + + 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/src/fltk-widgets-positioners.ads b/src/fltk-widgets-positioners.ads new file mode 100644 index 0000000..1da99b9 --- /dev/null +++ b/src/fltk-widgets-positioners.ads @@ -0,0 +1,194 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Widgets.Positioners is + + + type Positioner is new Widget with private; + + type Positioner_Reference (Data : not null access Positioner'Class) is limited null record + with Implicit_Dereference => Data; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Positioner; + + end Forge; + + + + + procedure Get_Coords + (This : in Positioner; + X, Y : out Long_Float); + + procedure Set_Coords + (This : in out Positioner; + X, Y : in Long_Float); + + function Set_Coords + (This : in out Positioner; + X, Y : in Long_Float) + return Boolean; + + + + + procedure Set_Ecks_Bounds + (This : in out Positioner; + Low, High : in Long_Float); + + procedure Set_Ecks_Step + (This : in out Positioner; + Value : in Long_Float); + + function Get_Ecks_Minimum + (This : in Positioner) + return Long_Float; + + procedure Set_Ecks_Minimum + (This : in out Positioner; + Value : in Long_Float); + + function Get_Ecks_Maximum + (This : in Positioner) + return Long_Float; + + procedure Set_Ecks_Maximum + (This : in out Positioner; + Value : in Long_Float); + + function Get_Ecks + (This : in Positioner) + return Long_Float; + + procedure Set_Ecks + (This : in out Positioner; + Value : in Long_Float); + + function Set_Ecks + (This : in out Positioner; + Value : in Long_Float) + return Boolean; + + + + + procedure Set_Why_Bounds + (This : in out Positioner; + Low, High : in Long_Float); + + procedure Set_Why_Step + (This : in out Positioner; + Value : in Long_Float); + + function Get_Why_Minimum + (This : in Positioner) + return Long_Float; + + procedure Set_Why_Minimum + (This : in out Positioner; + Value : in Long_Float); + + function Get_Why_Maximum + (This : in Positioner) + return Long_Float; + + procedure Set_Why_Maximum + (This : in out Positioner; + Value : in Long_Float); + + function Get_Why + (This : in Positioner) + return Long_Float; + + procedure Set_Why + (This : in out Positioner; + Value : in Long_Float); + + function Set_Why + (This : in out Positioner; + Value : in Long_Float) + return Boolean; + + + + + procedure Draw + (This : in out Positioner); + + procedure Draw + (This : in out Positioner; + X, Y, W, H : in Integer); + + function Handle + (This : in out Positioner; + Event : in Event_Kind) + return Event_Outcome; + + function Handle + (This : in out Positioner; + Event : in Event_Kind; + X, Y, W, H : in Integer) + return Event_Outcome; + + +private + + + type Positioner is new Widget with null record; + + overriding procedure Initialize + (This : in out Positioner); + + overriding procedure Finalize + (This : in out Positioner); + + procedure Extra_Init + (This : in out Positioner; + X, Y, W, H : in Integer; + Text : in String) + with Inline; + + procedure Extra_Final + (This : in out Positioner) + with Inline; + + + pragma Inline (Get_Coords); + pragma Inline (Set_Coords); + + pragma Inline (Set_Ecks_Bounds); + pragma Inline (Set_Ecks_Step); + pragma Inline (Get_Ecks_Minimum); + pragma Inline (Set_Ecks_Minimum); + pragma Inline (Get_Ecks_Maximum); + pragma Inline (Set_Ecks_Maximum); + pragma Inline (Get_Ecks); + pragma Inline (Set_Ecks); + + pragma Inline (Set_Why_Bounds); + pragma Inline (Set_Why_Step); + pragma Inline (Get_Why_Minimum); + pragma Inline (Set_Why_Minimum); + pragma Inline (Get_Why_Maximum); + pragma Inline (Set_Why_Maximum); + pragma Inline (Get_Why); + pragma Inline (Set_Why); + + pragma Inline (Draw); + pragma Inline (Handle); + + +end FLTK.Widgets.Positioners; + + |