Filled holes in Enumerations and FLTK (Screen) APIs

12 files changed, 467 insertions, 21 deletions

diff --git a/body/c_fl.cpp b/body/c_fl.cpp
index 24119a6..42d9a45 100644
--- a/body/c_fl.cpp
+++ b/body/c_fl.cpp
@@ -52,12 +52,65 @@ size_t c_pointer_size() {
 
 
 
+const int fl_enum_num_red   = FL_NUM_RED;
+const int fl_enum_num_green = FL_NUM_GREEN;
+const int fl_enum_num_blue  = FL_NUM_BLUE;
+const int fl_enum_num_gray  = FL_NUM_GRAY;
+
+
+
+
+unsigned int fl_enum_rgb_color2(unsigned char l) {
+    return static_cast<unsigned int>(fl_rgb_color(l));
+}
+
 unsigned int fl_enum_rgb_color(unsigned char r, unsigned char g, unsigned char b) {
-    return fl_rgb_color(r, g, b);
+    return static_cast<unsigned int>(fl_rgb_color(r, g, b));
+}
+
+unsigned int fl_enum_color_cube(int r, int g, int b) {
+    return static_cast<unsigned int>(fl_color_cube(r, g, b));
+}
+
+unsigned int fl_enum_gray_ramp(int l) {
+    return static_cast<unsigned int>(fl_gray_ramp(l));
+}
+
+unsigned int fl_enum_darker(unsigned int c) {
+    return static_cast<unsigned int>(fl_darker(static_cast<Fl_Color>(c)));
+}
+
+unsigned int fl_enum_lighter(unsigned int c) {
+    return static_cast<unsigned int>(fl_lighter(static_cast<Fl_Color>(c)));
 }
 
 unsigned int fl_enum_contrast(unsigned int f, unsigned int b) {
-    return fl_contrast(f, b);
+    return static_cast<unsigned int>(fl_contrast
+        (static_cast<Fl_Color>(f), static_cast<Fl_Color>(b)));
+}
+
+unsigned int fl_enum_inactive(unsigned int c) {
+    return static_cast<unsigned int>(fl_inactive(static_cast<Fl_Color>(c)));
+}
+
+unsigned int fl_enum_color_average(unsigned int c1, unsigned int c2, float w) {
+    return static_cast<unsigned int>(fl_color_average
+        (static_cast<Fl_Color>(c1), static_cast<Fl_Color>(c2), w));
+}
+
+
+
+
+int fl_enum_box(int b) {
+    return static_cast<int>(fl_box(static_cast<Fl_Boxtype>(b)));
+}
+
+int fl_enum_frame(int b) {
+    return static_cast<int>(fl_frame(static_cast<Fl_Boxtype>(b)));
+}
+
+int fl_enum_down(int b) {
+    return static_cast<int>(fl_down(static_cast<Fl_Boxtype>(b)));
 }
 
 
diff --git a/body/c_fl.h b/body/c_fl.h
index b12f560..f85c36f 100644
--- a/body/c_fl.h
+++ b/body/c_fl.h
@@ -43,8 +43,26 @@ extern "C" const short fl_mod_command;
 extern "C" size_t c_pointer_size();
 
 
+extern "C" const int fl_enum_num_red;
+extern "C" const int fl_enum_num_green;
+extern "C" const int fl_enum_num_blue;
+extern "C" const int fl_enum_num_gray;
+
+
+extern "C" unsigned int fl_enum_rgb_color2(unsigned char l);
 extern "C" unsigned int fl_enum_rgb_color(unsigned char r, unsigned char g, unsigned char b);
+extern "C" unsigned int fl_enum_color_cube(int r, int g, int b);
+extern "C" unsigned int fl_enum_gray_ramp(int l);
+extern "C" unsigned int fl_enum_darker(unsigned int c);
+extern "C" unsigned int fl_enum_lighter(unsigned int c);
 extern "C" unsigned int fl_enum_contrast(unsigned int f, unsigned int b);
+extern "C" unsigned int fl_enum_inactive(unsigned int c);
+extern "C" unsigned int fl_enum_color_average(unsigned int c1, unsigned int c2, float w);
+
+
+extern "C" int fl_enum_box(int b);
+extern "C" int fl_enum_frame(int b);
+extern "C" int fl_enum_down(int b);
 
 
 extern "C" int fl_abi_check(int v);
diff --git a/body/c_fl_screen.cpp b/body/c_fl_screen.cpp
index 88550bd..d0e8019 100644
--- a/body/c_fl_screen.cpp
+++ b/body/c_fl_screen.cpp
@@ -8,6 +8,15 @@
 #include "c_fl_screen.h"
 
 
+
+
+void fl_screen_display(const char * v) {
+    Fl::display(v);
+}
+
+
+
+
 int fl_screen_x() {
     return Fl::x();
 }
diff --git a/body/c_fl_screen.h b/body/c_fl_screen.h
index 9b4d4ec..8fff58d 100644
--- a/body/c_fl_screen.h
+++ b/body/c_fl_screen.h
@@ -8,6 +8,9 @@
 #define FL_SCREEN_GUARD
 
 
+extern "C" void fl_screen_display(const char * v);
+
+
 extern "C" int fl_screen_x();
 extern "C" int fl_screen_y();
 extern "C" int fl_screen_w();
diff --git a/body/fltk-screen.adb b/body/fltk-screen.adb
index c7c7957..54618fe 100644
--- a/body/fltk-screen.adb
+++ b/body/fltk-screen.adb
@@ -20,6 +20,16 @@ package body FLTK.Screen is
     --  Functions From C  --
     ------------------------
 
+    --  Environment  --
+
+    procedure fl_screen_display
+           (V : in Interfaces.C.char_array);
+    pragma Import (C, fl_screen_display, "fl_screen_display");
+    pragma Inline (fl_screen_display);
+
+
+
+
     --  Basic Dimensions  --
 
     function fl_screen_x
@@ -127,6 +137,17 @@ package body FLTK.Screen is
     --  API Subprograms  --
     -----------------------
 
+    --  Environment  --
+
+    procedure Set_Display_Var
+           (Value : in String) is
+    begin
+        fl_screen_display (Interfaces.C.To_C (Value));
+    end Set_Display_Var;
+
+
+
+
     --  Basic Dimensions  --
 
     function Get_X return Integer is
diff --git a/body/fltk.adb b/body/fltk.adb
index aaef1fd..cebf1a9 100644
--- a/body/fltk.adb
+++ b/body/fltk.adb
@@ -11,6 +11,7 @@ with
 use type
 
     Interfaces.C.int,
+    Interfaces.C.unsigned_char,
     Interfaces.C.unsigned_long;
 
 
@@ -18,26 +19,115 @@ package body FLTK is
 
 
     ------------------------
+    --  Constants From C  --
+    ------------------------
+
+    fl_enum_num_red : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_num_red);
+
+    fl_enum_num_green : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_num_green);
+
+    fl_enum_num_blue : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_num_blue);
+
+    fl_enum_num_gray : constant Interfaces.C.int;
+    pragma Import (C, fl_enum_num_gray);
+
+
+
+
+    ------------------------
     --  Functions From C  --
     ------------------------
 
     --  Enumerations.H  --
 
+    --  Color  --
+
+    function fl_enum_rgb_color2
+           (L : in Interfaces.C.unsigned_char)
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_enum_rgb_color2, "fl_enum_rgb_color2");
+    pragma Inline (fl_enum_rgb_color2);
+
     function fl_enum_rgb_color
            (R, G, B : in Interfaces.C.unsigned_char)
         return Interfaces.C.unsigned;
     pragma Import (C, fl_enum_rgb_color, "fl_enum_rgb_color");
     pragma Inline (fl_enum_rgb_color);
 
+    function fl_enum_color_cube
+           (R, G, B : in Interfaces.C.int)
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_enum_color_cube, "fl_enum_color_cube");
+    pragma Inline (fl_enum_color_cube);
+
+    function fl_enum_gray_ramp
+           (L : in Interfaces.C.int)
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_enum_gray_ramp, "fl_enum_gray_ramp");
+    pragma Inline (fl_enum_gray_ramp);
+
+    function fl_enum_darker
+           (T : in Interfaces.C.unsigned)
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_enum_darker, "fl_enum_darker");
+    pragma Inline (fl_enum_darker);
+
+    function fl_enum_lighter
+           (T : in Interfaces.C.unsigned)
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_enum_lighter, "fl_enum_lighter");
+    pragma Inline (fl_enum_lighter);
+
     function fl_enum_contrast
            (F, B : in Interfaces.C.unsigned)
         return Interfaces.C.unsigned;
     pragma Import (C, fl_enum_contrast, "fl_enum_contrast");
     pragma Inline (fl_enum_contrast);
 
+    function fl_enum_inactive
+           (T : in Interfaces.C.unsigned)
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_enum_inactive, "fl_enum_inactive");
+    pragma Inline (fl_enum_inactive);
+
+    function fl_enum_color_average
+           (T1, T2 : in Interfaces.C.unsigned;
+            W      : in Interfaces.C.C_float)
+        return Interfaces.C.unsigned;
+    pragma Import (C, fl_enum_color_average, "fl_enum_color_average");
+    pragma Inline (fl_enum_color_average);
+
+
+
+
+    --  Box Types  --
+
+    function fl_enum_box
+           (B : in Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_enum_box, "fl_enum_box");
+    pragma Inline (fl_enum_box);
+
+    function fl_enum_frame
+           (B : in Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_enum_frame, "fl_enum_frame");
+    pragma Inline (fl_enum_frame);
+
+    function fl_enum_down
+           (B : in Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_enum_down, "fl_enum_down");
+    pragma Inline (fl_enum_down);
 
 
 
+
+    --  Fl.H  --
+
     --  Versioning  --
 
     function fl_abi_check
@@ -129,6 +219,26 @@ package body FLTK is
     --  Color  --
 
     function RGB_Color
+           (Light : in Greyscale)
+        return Color is
+    begin
+        case Light is
+        when 'A' .. 'W' => return Color (fl_enum_rgb_color2
+            ((Greyscale'Pos (Light) - Greyscale'Pos (Greyscale'First)) * 11));
+        when 'X' => return Color (fl_enum_rgb_color2 (255));
+        end case;
+    end RGB_Color;
+
+
+    function RGB_Color
+           (Light : in Color_Component)
+        return Color is
+    begin
+        return Color (fl_enum_rgb_color2 (Interfaces.C.unsigned_char (Light)));
+    end RGB_Color;
+
+
+    function RGB_Color
            (R, G, B : in Color_Component)
         return Color is
     begin
@@ -139,6 +249,50 @@ package body FLTK is
     end RGB_Color;
 
 
+    function Color_Cube
+           (R, G, B : in Color_Component)
+        return Color is
+    begin
+        return Color (fl_enum_color_cube
+           (Interfaces.C.int (Float'Rounding (Float (R) * Float (fl_enum_num_red   - 1) / 255.0)),
+            Interfaces.C.int (Float'Rounding (Float (G) * Float (fl_enum_num_green - 1) / 255.0)),
+            Interfaces.C.int (Float'Rounding (Float (B) * Float (fl_enum_num_blue  - 1) / 255.0))));
+    end Color_Cube;
+
+
+    function Grey_Ramp
+           (Light : in Greyscale)
+        return Color is
+    begin
+        return Color (fl_enum_gray_ramp (Greyscale'Pos (Light) - Greyscale'Pos (Greyscale'First)));
+    end Grey_Ramp;
+
+
+    function Grey_Ramp
+           (Light : in Color_Component)
+        return Color is
+    begin
+        return Color (fl_enum_gray_ramp (Interfaces.C.int
+            (Float'Rounding (Float (Light) * Float (fl_enum_num_gray - 1) / 255.0))));
+    end Grey_Ramp;
+
+
+    function Darker
+           (Tone : in Color)
+        return Color is
+    begin
+        return Color (fl_enum_darker (Interfaces.C.unsigned (Tone)));
+    end Darker;
+
+
+    function Lighter
+           (Tone : in Color)
+        return Color is
+    begin
+        return Color (fl_enum_lighter (Interfaces.C.unsigned (Tone)));
+    end Lighter;
+
+
     function Contrast
            (Fore, Back : in Color)
         return Color is
@@ -149,6 +303,26 @@ package body FLTK is
     end Contrast;
 
 
+    function Inactive
+           (Tone : in Color)
+        return Color is
+    begin
+        return Color (fl_enum_inactive (Interfaces.C.unsigned (Tone)));
+    end Inactive;
+
+
+    function Color_Average
+           (Tone1, Tone2 : in Color;
+            Weight       : in Blend := 0.5)
+        return Color is
+    begin
+        return Color (fl_enum_color_average
+           (Interfaces.C.unsigned (Tone1),
+            Interfaces.C.unsigned (Tone2),
+            Interfaces.C.C_float (Weight)));
+    end Color_Average;
+
+
 
 
     --  Alignment  --
@@ -361,6 +535,52 @@ package body FLTK is
 
 
 
+    --  Box Types  --
+
+    function Filled
+           (Box : in Box_Kind)
+        return Box_Kind
+    is
+        Result : Interfaces.C.int := fl_enum_box (Box_Kind'Pos (Box));
+    begin
+        return Box_Kind'Val (Result);
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "fl_box in Enumerations.H returned unexpected int value of " &
+        Interfaces.C.int'Image (Result);
+    end Filled;
+
+
+    function Frame
+           (Box : in Box_Kind)
+        return Box_Kind
+    is
+        Result : Interfaces.C.int := fl_enum_frame (Box_Kind'Pos (Box));
+    begin
+        return Box_Kind'Val (Result);
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "fl_frame in Enumerations.H returned unexpected int value of " &
+        Interfaces.C.int'Image (Result);
+    end Frame;
+
+
+    function Down
+           (Box : in Box_Kind)
+        return Box_Kind
+    is
+        Result : Interfaces.C.int := fl_enum_down (Box_Kind'Pos (Box));
+    begin
+        return Box_Kind'Val (Result);
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "fl_down in Enumerations.H returned unexpected int value of " &
+        Interfaces.C.int'Image (Result);
+    end Down;
+
+
+
+
     --  Menu Flags  --
 
     function "+"
diff --git a/doc/enumerations.html b/doc/enumerations.html
index 9106ff3..937a7a9 100644
--- a/doc/enumerations.html
+++ b/doc/enumerations.html
@@ -57,6 +57,11 @@
   </tr>
 
   <tr>
+    <td>float</td>
+    <td>Blend</td>
+  </tr>
+
+  <tr>
     <td>Fl_Align</td>
     <td>Alignment</td>
   </tr>
@@ -72,7 +77,11 @@
   </tr>
 
   <tr>
-    <td>#define</td>
+    <td>
+      #define FL_LEFT_MOUSE 1<br />
+      #define FL_MIDDLE_MOUSE 2<br />
+      #define FL_RIGHT_MOUSE 3
+    </td>
     <td>Mouse_Button</td>
   </tr>
 
@@ -142,21 +151,34 @@
 <td><pre>
 inline Fl_Boxtype fl_box(Fl_Boxtype b);
 </pre></td>
-<td>&nbsp;</td>
+<td><pre>
+function Filled
+       (Box : in Box_Kind)
+    return Box_Kind;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 Fl_Color fl_color_average(Fl_Color c1, Fl_Color c2, float weight);
 </pre></td>
-<td>&nbsp;</td>
+<td><pre>
+function Color_Average
+       (Tone1, Tone2 : in Color;
+        Weight       : in Blend := 0.5)
+    return Color;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 inline Fl_Color fl_color_cube(int r, int g, int b);
 </pre></td>
-<td>&nbsp;</td>
+<td><pre>
+function Color_Cube
+       (R, G, B : in Color_Component)
+    return Color;
+</pre></td>
   </tr>
 
   <tr>
@@ -174,49 +196,85 @@ function Contrast
 <td><pre>
 inline Fl_Color fl_darker(Fl_Color c);
 </pre></td>
-<td>&nbsp;</td>
+<td><pre>
+function Darker
+       (Tone : in Color)
+    return Color;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 inline Fl_Boxtype fl_down(Fl_Boxtype b);
 </pre></td>
-<td>&nbsp;</td>
+<td><pre>
+function Down
+       (Box : in Box_Kind)
+    return Box_Kind;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 inline Fl_Boxtype fl_frame(Fl_Boxtype b);
 </pre></td>
-<td>&nbsp;</td>
+<td><pre>
+function Frame
+       (Box : in Box_Kind)
+    return Box_Kind;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 inline Fl_Color fl_gray_ramp(int i);
 </pre></td>
-<td>&nbsp;</td>
+<td><pre>
+function Grey_Ramp
+       (Light : in Greyscale)
+    return Color;
+
+function Grey_Ramp
+       (Light : in Color_Component)
+    return Color;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 Fl_Color fl_inactive(Fl_Color c);
 </pre></td>
-<td>&nbsp;</td>
+<td><pre>
+function Inactive
+       (Tone : in Color)
+    return Color;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 inline Fl_Color fl_lighter(Fl_Color c);
 </pre></td>
-<td>&nbsp;</td>
+<td><pre>
+function Lighter
+       (Tone : in Color)
+    return Color;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 inline Fl_Color fl_rgb_color(uchar g);
 </pre></td>
-<td>&nbsp;</td>
+<td><pre>
+function RGB_Color
+       (Light : in Greyscale)
+    return Color;
+
+function RGB_Color
+       (Light : in Color_Component)
+    return Color;
+</pre></td>
   </tr>
 
   <tr>
diff --git a/doc/fl_(fltk-screen).html b/doc/fl_(fltk-screen).html
index b44267c..fddc17d 100644
--- a/doc/fl_(fltk-screen).html
+++ b/doc/fl_(fltk-screen).html
@@ -35,7 +35,10 @@
 <td><pre>
 static void display(const char *);
 </pre></td>
-<td>&nbsp;</td>
+<td><pre>
+procedure Set_Display_Var
+       (Value : in String);
+</pre></td>
   </tr>
 
   <tr>
diff --git a/doc/fl_image.html b/doc/fl_image.html
index 10c9ed8..201a2fa 100644
--- a/doc/fl_image.html
+++ b/doc/fl_image.html
@@ -46,11 +46,6 @@
     <td>Scaling_Kind</td>
   </tr>
 
-  <tr>
-    <td>float</td>
-    <td>Blend</td>
-  </tr>
-
 </table>
 
 
diff --git a/spec/fltk-images.ads b/spec/fltk-images.ads
index 165c203..6afb788 100644
--- a/spec/fltk-images.ads
+++ b/spec/fltk-images.ads
@@ -14,8 +14,6 @@ package FLTK.Images is
 
     type Scaling_Kind is (Nearest, Bilinear);
 
-    type Blend is new Float range 0.0 .. 1.0;
-
 
     No_Image_Error, File_Access_Error, Format_Error : exception;
 
diff --git a/spec/fltk-screen.ads b/spec/fltk-screen.ads
index b7d5521..8a26d9c 100644
--- a/spec/fltk-screen.ads
+++ b/spec/fltk-screen.ads
@@ -7,6 +7,14 @@
 package FLTK.Screen is
 
 
+    --  Environment  --
+
+    procedure Set_Display_Var
+           (Value : in String);
+
+
+
+
     --  Basic Dimensions  --
 
     function Get_X
@@ -82,6 +90,8 @@ package FLTK.Screen is
 private
 
 
+    pragma Inline (Set_Display_Var);
+
     pragma Inline (Get_X);
     pragma Inline (Get_Y);
     pragma Inline (Get_W);
diff --git a/spec/fltk.ads b/spec/fltk.ads
index db75720..24e68fe 100644
--- a/spec/fltk.ads
+++ b/spec/fltk.ads
@@ -46,14 +46,53 @@ package FLTK is
     type Color_Component is mod 256;
     type Color_Component_Array is array (Positive range <>) of aliased Color_Component;
 
+    subtype Blend is Float range 0.0 .. 1.0;
+
+    function RGB_Color
+           (Light : in Greyscale)
+        return Color;
+
+    function RGB_Color
+           (Light : in Color_Component)
+        return Color;
+
     function RGB_Color
            (R, G, B : in Color_Component)
         return Color;
 
+    function Color_Cube
+           (R, G, B : in Color_Component)
+        return Color;
+
+    function Grey_Ramp
+           (Light : in Greyscale)
+        return Color;
+
+    function Grey_Ramp
+           (Light : in Color_Component)
+        return Color;
+
+    function Darker
+           (Tone : in Color)
+        return Color;
+
+    function Lighter
+           (Tone : in Color)
+        return Color;
+
     function Contrast
            (Fore, Back : in Color)
         return Color;
 
+    function Inactive
+           (Tone : in Color)
+        return Color;
+
+    function Color_Average
+           (Tone1, Tone2 : in Color;
+            Weight       : in Blend := 0.5)
+        return Color;
+
     --  Examples of RGB colors without the above function
     --  The lowest byte has to be 00 for the color to be RGB
     RGB_Red_Color   : constant Color := 16#ff000000#;
@@ -282,6 +321,18 @@ package FLTK is
         Gleam_Round_Down_Box,
         Free_Box);
 
+    function Filled
+           (Box : in Box_Kind)
+        return Box_Kind;
+
+    function Frame
+           (Box : in Box_Kind)
+        return Box_Kind;
+
+    function Down
+           (Box : in Box_Kind)
+        return Box_Kind;
+
 
 
 
@@ -662,7 +713,14 @@ private
 
 
     pragma Inline (RGB_Color);
+    pragma Inline (Color_Cube);
+    pragma Inline (Contrast);
+    pragma Inline (Grey_Ramp);
+    pragma Inline (Darker);
+    pragma Inline (Lighter);
     pragma Inline (Contrast);
+    pragma Inline (Inactive);
+    pragma Inline (Color_Average);
 
     pragma Inline (ABI_Check);
     pragma Inline (ABI_Version);