Filled holes in Enumerations and FLTK (Screen) APIs

6 files changed, 326 insertions, 2 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 "+"