Added FLTK.Images.Shared and completed FLTK.Devices.Surfaces.Image

9 files changed, 547 insertions, 3 deletions

diff --git a/progress.txt b/progress.txt
index e92bd6c..d8504e7 100644
--- a/progress.txt
+++ b/progress.txt
@@ -19,6 +19,7 @@ Done:
 
 FLTK.Devices
 FLTK.Devices.Surfaces.Copy
+FLTK.Devices.Surfaces.Image
 FLTK.Devices.Surfaces.Paged
 FLTK.Devices.Surfaces.Paged.Printers
 FLTK.Dialogs
@@ -30,6 +31,7 @@ FLTK.Images.RGB.BMP
 FLTK.Images.RGB.JPEG
 FLTK.Images.RGB.PNG
 FLTK.Images.RGB.PNM
+FLTK.Images.Shared
 FLTK.Tooltips
 FLTK.Widgets.Boxes
 FLTK.Widgets.Buttons
@@ -95,7 +97,6 @@ Partially Done:
 FLTK
 FLTK.Devices.Graphics
 FLTK.Devices.Surfaces
-FLTK.Devices.Surfaces.Image
 FLTK.Environment
 FLTK.Menu_Items
 FLTK.Screen
@@ -114,7 +115,6 @@ To-Do:
 FL_Pixmap
 FL_GIF_Image
 FL_XPM_Image
-FL_Shared_Image
 FL_Tiled_Image
 FL_Browser
 FL_Check_Browser
diff --git a/src/c_fl_image_surface.cpp b/src/c_fl_image_surface.cpp
index eb8d26e..305e3cc 100644
--- a/src/c_fl_image_surface.cpp
+++ b/src/c_fl_image_surface.cpp
@@ -35,6 +35,10 @@ void * fl_image_surface_image(IMAGE_SURFACE s) {
     return reinterpret_cast<Fl_Image_Surface*>(s)->image();
 }
 
+void * fl_image_surface_highres_image(IMAGE_SURFACE s) {
+    return reinterpret_cast<Fl_Image_Surface*>(s)->highres_image();
+}
+
 
 
 
diff --git a/src/c_fl_image_surface.h b/src/c_fl_image_surface.h
index 3ecafd3..0ad97a3 100644
--- a/src/c_fl_image_surface.h
+++ b/src/c_fl_image_surface.h
@@ -22,6 +22,7 @@ extern "C" void fl_image_surface_draw_decorated_window(IMAGE_SURFACE s, void * w
 
 
 extern "C" void * fl_image_surface_image(IMAGE_SURFACE s);
+extern "C" void * fl_image_surface_highres_image(IMAGE_SURFACE s);
 
 
 extern "C" void fl_image_surface_set_current(IMAGE_SURFACE s);
diff --git a/src/c_fl_shared_image.cpp b/src/c_fl_shared_image.cpp
new file mode 100644
index 0000000..c31b12f
--- /dev/null
+++ b/src/c_fl_shared_image.cpp
@@ -0,0 +1,82 @@
+
+
+#include <FL/Fl_Shared_Image.H>
+#include <FL/Fl_RGB_Image.H>
+#include "c_fl_shared_image.h"
+
+
+
+
+SHARED_IMAGE fl_shared_image_get(const char * f, int w, int h) {
+    return Fl_Shared_Image::get(f, w, h);
+}
+
+SHARED_IMAGE fl_shared_image_get2(void * r) {
+    return Fl_Shared_Image::get(reinterpret_cast<Fl_RGB_Image*>(r));
+}
+
+SHARED_IMAGE fl_shared_image_find(const char * n, int w, int h) {
+    return Fl_Shared_Image::find(n, w, h);
+}
+
+void release_fl_shared_image(SHARED_IMAGE i) {
+    reinterpret_cast<Fl_Shared_Image*>(i)->release();
+}
+
+SHARED_IMAGE fl_shared_image_copy(SHARED_IMAGE i, int w, int h) {
+    return reinterpret_cast<Fl_Shared_Image*>(i)->copy(w, h);
+}
+
+SHARED_IMAGE fl_shared_image_copy2(SHARED_IMAGE i) {
+    return reinterpret_cast<Fl_Shared_Image*>(i)->copy();
+}
+
+
+
+
+void fl_shared_image_color_average(SHARED_IMAGE i, int c, float b) {
+    reinterpret_cast<Fl_Shared_Image*>(i)->color_average(c, b);
+}
+
+void fl_shared_image_desaturate(SHARED_IMAGE i) {
+    reinterpret_cast<Fl_Shared_Image*>(i)->desaturate();
+}
+
+
+
+
+const char * fl_shared_image_name(SHARED_IMAGE i) {
+    return reinterpret_cast<Fl_Shared_Image*>(i)->name();
+}
+
+void fl_shared_image_reload(SHARED_IMAGE i) {
+    reinterpret_cast<Fl_Shared_Image*>(i)->reload();
+}
+
+void fl_shared_image_uncache(SHARED_IMAGE i) {
+    reinterpret_cast<Fl_Shared_Image*>(i)->uncache();
+}
+
+
+
+
+void fl_shared_image_scaling_algorithm(int v) {
+    Fl_Shared_Image::scaling_algorithm(static_cast<Fl_RGB_Scaling>(v));
+}
+
+void fl_shared_image_scale(SHARED_IMAGE i, int w, int h, int p, int e) {
+    reinterpret_cast<Fl_Shared_Image*>(i)->scale(w, h, p, e);
+}
+
+
+
+
+void fl_shared_image_draw(SHARED_IMAGE i, int x, int y, int w, int h, int cx, int cy) {
+    reinterpret_cast<Fl_Shared_Image*>(i)->draw(x, y, w, h, cx, cy);
+}
+
+void fl_shared_image_draw2(SHARED_IMAGE i, int x, int y) {
+    reinterpret_cast<Fl_Shared_Image*>(i)->draw(x, y);
+}
+
+
diff --git a/src/c_fl_shared_image.h b/src/c_fl_shared_image.h
new file mode 100644
index 0000000..6c6abdf
--- /dev/null
+++ b/src/c_fl_shared_image.h
@@ -0,0 +1,42 @@
+
+
+#ifndef FL_SHARED_IMAGE_GUARD
+#define FL_SHARED_IMAGE_GUARD
+
+
+
+
+typedef void* SHARED_IMAGE;
+
+
+
+
+extern "C" SHARED_IMAGE fl_shared_image_get(const char * f, int w, int h);
+extern "C" SHARED_IMAGE fl_shared_image_get2(void * r);
+extern "C" SHARED_IMAGE fl_shared_image_find(const char * n, int w, int h);
+extern "C" void release_fl_shared_image(SHARED_IMAGE i);
+extern "C" SHARED_IMAGE fl_shared_image_copy(SHARED_IMAGE i, int w, int h);
+extern "C" SHARED_IMAGE fl_shared_image_copy2(SHARED_IMAGE i);
+
+
+
+
+extern "C" void fl_shared_image_color_average(SHARED_IMAGE i, int c, float b);
+extern "C" void fl_shared_image_desaturate(SHARED_IMAGE i);
+
+
+extern "C" const char * fl_shared_image_name(SHARED_IMAGE i);
+extern "C" void fl_shared_image_reload(SHARED_IMAGE i);
+extern "C" void fl_shared_image_uncache(SHARED_IMAGE i);
+
+
+extern "C" void fl_shared_image_scaling_algorithm(int v);
+extern "C" void fl_shared_image_scale(SHARED_IMAGE i, int w, int h, int p, int e);
+
+
+extern "C" void fl_shared_image_draw(SHARED_IMAGE i, int x, int y, int w, int h, int cx, int cy);
+extern "C" void fl_shared_image_draw2(SHARED_IMAGE i, int x, int y);
+
+
+#endif
+
diff --git a/src/fltk-devices-surfaces-image.adb b/src/fltk-devices-surfaces-image.adb
index 0621e39..1955bf3 100644
--- a/src/fltk-devices-surfaces-image.adb
+++ b/src/fltk-devices-surfaces-image.adb
@@ -44,6 +44,11 @@ package body FLTK.Devices.Surfaces.Image is
         return System.Address;
     pragma Import (C, fl_image_surface_image, "fl_image_surface_image");
 
+    function fl_image_surface_highres_image
+           (S : in System.Address)
+        return System.Address;
+    pragma Import (C, fl_image_surface_highres_image, "fl_image_surface_highres_image");
+
 
 
 
@@ -138,6 +143,16 @@ package body FLTK.Devices.Surfaces.Image is
     end Get_Image;
 
 
+    function Get_Highres_Image
+           (This : in Image_Surface)
+        return FLTK.Images.Shared.Shared_Image is
+    begin
+        return Img : FLTK.Images.Shared.Shared_Image do
+            Wrapper (Img).Void_Ptr := fl_image_surface_highres_image (This.Void_Ptr);
+        end return;
+    end Get_Highres_Image;
+
+
 
 
     procedure Set_Current
diff --git a/src/fltk-devices-surfaces-image.ads b/src/fltk-devices-surfaces-image.ads
index 1c7e383..6023af2 100644
--- a/src/fltk-devices-surfaces-image.ads
+++ b/src/fltk-devices-surfaces-image.ads
@@ -3,6 +3,7 @@
 with
 
     FLTK.Images.RGB,
+    FLTK.Images.Shared,
     FLTK.Widgets.Groups.Windows;
 
 
@@ -50,7 +51,9 @@ package FLTK.Devices.Surfaces.Image is
            (This : in Image_Surface)
         return FLTK.Images.RGB.RGB_Image;
 
-    --  Get_Highres_Image
+    function Get_Highres_Image
+           (This : in Image_Surface)
+        return FLTK.Images.Shared.Shared_Image;
 
 
 
diff --git a/src/fltk-images-shared.adb b/src/fltk-images-shared.adb
new file mode 100644
index 0000000..e5bd240
--- /dev/null
+++ b/src/fltk-images-shared.adb
@@ -0,0 +1,290 @@
+
+
+with
+
+    Interfaces.C.Strings,
+    System;
+
+use type
+
+    System.Address;
+
+
+package body FLTK.Images.Shared is
+
+
+    function fl_shared_image_get
+           (F    : in Interfaces.C.char_array;
+            W, H : in Interfaces.C.int)
+        return System.Address;
+    pragma Import (C, fl_shared_image_get, "fl_shared_image_get");
+
+    function fl_shared_image_get2
+           (I : in System.Address)
+        return System.Address;
+    pragma Import (C, fl_shared_image_get2, "fl_shared_image_get2");
+
+    function fl_shared_image_find
+           (N    : in Interfaces.C.char_array;
+            W, H : in Interfaces.C.int)
+        return System.Address;
+    pragma Import (C, fl_shared_image_find, "fl_shared_image_find");
+
+    procedure fl_shared_image_release
+           (I : in System.Address);
+    pragma Import (C, fl_shared_image_release, "fl_shared_image_release");
+
+    function fl_shared_image_copy
+           (I    : in System.Address;
+            W, H : in Interfaces.C.int)
+        return System.Address;
+    pragma Import (C, fl_shared_image_copy, "fl_shared_image_copy");
+
+    function fl_shared_image_copy2
+           (I : in System.Address)
+        return System.Address;
+    pragma Import (C, fl_shared_image_copy2, "fl_shared_image_copy2");
+
+
+
+
+    procedure fl_shared_image_color_average
+           (I : in System.Address;
+            C : in Interfaces.C.int;
+            B : in Interfaces.C.C_float);
+    pragma Import (C, fl_shared_image_color_average, "fl_shared_image_color_average");
+
+    procedure fl_shared_image_desaturate
+           (I : in System.Address);
+    pragma Import (C, fl_shared_image_desaturate, "fl_shared_image_desaturate");
+
+
+
+
+    function fl_shared_image_name
+           (I : in System.Address)
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, fl_shared_image_name, "fl_shared_image_name");
+
+    procedure fl_shared_image_reload
+           (I : in System.Address);
+    pragma Import (C, fl_shared_image_reload, "fl_shared_image_reload");
+
+    procedure fl_shared_image_uncache
+           (I : in System.Address);
+    pragma Import (C, fl_shared_image_uncache, "fl_shared_image_uncache");
+
+
+
+
+    procedure fl_shared_image_scaling_algorithm
+           (A : in Interfaces.C.int);
+    pragma Import (C, fl_shared_image_scaling_algorithm, "fl_shared_image_scaling_algorithm");
+
+    procedure fl_shared_image_scale
+           (I : in System.Address;
+            W, H, P, E : in Interfaces.C.int);
+    pragma Import (C, fl_shared_image_scale, "fl_shared_image_scale");
+
+
+
+
+    procedure fl_shared_image_draw
+           (I                  : in System.Address;
+            X, Y, W, H, CX, CY : in Interfaces.C.int);
+    pragma Import (C, fl_shared_image_draw, "fl_shared_image_draw");
+
+    procedure fl_shared_image_draw2
+           (I    : in System.Address;
+            X, Y : in Interfaces.C.int);
+    pragma Import (C, fl_shared_image_draw2, "fl_shared_image_draw2");
+
+
+
+
+    overriding procedure Finalize
+           (This : in out Shared_Image) is
+    begin
+        if  This.Void_Ptr /= System.Null_Address and then
+            This in Shared_Image'Class
+        then
+            fl_shared_image_release (This.Void_Ptr);
+            This.Void_Ptr := System.Null_Address;
+        end if;
+        Finalize (Image (This));
+    end Finalize;
+
+
+
+
+    package body Forge is
+
+        function Create
+               (Filename : in String;
+                W, H     : in Integer)
+            return Shared_Image is
+        begin
+            return This : Shared_Image do
+                This.Void_Ptr := fl_shared_image_get
+                   (Interfaces.C.To_C (Filename),
+                    Interfaces.C.int (W),
+                    Interfaces.C.int (H));
+            end return;
+        end Create;
+
+
+        function Create
+               (From : in FLTK.Images.RGB.RGB_Image'Class)
+            return Shared_Image is
+        begin
+            return This : Shared_Image do
+                This.Void_Ptr := fl_shared_image_get2 (Wrapper (From).Void_Ptr);
+            end return;
+        end Create;
+
+
+        function Find
+               (Name : in String;
+                W, H : in Integer := 0)
+            return Shared_Image is
+        begin
+            return This : Shared_Image do
+                This.Void_Ptr := fl_shared_image_find
+                   (Interfaces.C.To_C (Name),
+                    Interfaces.C.int (W),
+                    Interfaces.C.int (H));
+                if This.Void_Ptr = System.Null_Address then
+                    raise No_Image_Error;
+                end if;
+            end return;
+        end Find;
+
+    end Forge;
+
+
+
+
+    function Copy
+           (This          : in Shared_Image;
+            Width, Height : in Natural)
+        return Shared_Image'Class is
+    begin
+        return Copied : Shared_Image do
+            Copied.Void_Ptr := fl_shared_image_copy
+                   (This.Void_Ptr,
+                    Interfaces.C.int (Width),
+                    Interfaces.C.int (Height));
+        end return;
+    end Copy;
+
+
+    function Copy
+           (This : in Shared_Image)
+        return Shared_Image'Class is
+    begin
+        return Copied : Shared_Image do
+            Copied.Void_Ptr := fl_shared_image_copy2 (This.Void_Ptr);
+        end return;
+    end Copy;
+
+
+
+
+    procedure Color_Average
+           (This   : in out Shared_Image;
+            Col    : in     Color;
+            Amount : in     Blend) is
+    begin
+        fl_shared_image_color_average
+               (This.Void_Ptr,
+                Interfaces.C.int (Col),
+                Interfaces.C.C_float (Amount));
+    end Color_Average;
+
+
+    procedure Desaturate
+           (This : in out Shared_Image) is
+    begin
+        fl_shared_image_desaturate (This.Void_Ptr);
+    end Desaturate;
+
+
+
+
+    function Name
+           (This : in Shared_Image)
+        return String is
+    begin
+        return Interfaces.C.Strings.Value (fl_shared_image_name (This.Void_Ptr));
+    end Name;
+
+
+    procedure Reload
+           (This : in out Shared_Image) is
+    begin
+        fl_shared_image_reload (This.Void_Ptr);
+    end Reload;
+
+
+    procedure Uncache
+           (This : in out Shared_Image) is
+    begin
+        fl_shared_image_uncache (This.Void_Ptr);
+    end Uncache;
+
+
+
+
+    procedure Set_Scaling_Algorithm
+           (To : in Scaling_Kind) is
+    begin
+        fl_shared_image_scaling_algorithm (Scaling_Kind'Pos (To));
+    end Set_Scaling_Algorithm;
+
+
+    procedure Scale
+           (This         : in out Shared_Image;
+            W, H         : in     Integer;
+            Proportional : in     Boolean := True;
+            Can_Expand   : in     Boolean := False) is
+    begin
+        fl_shared_image_scale
+           (This.Void_Ptr,
+            Interfaces.C.int (W),
+            Interfaces.C.int (H),
+            Boolean'Pos (Proportional),
+            Boolean'Pos (Can_Expand));
+    end Scale;
+
+
+
+
+    procedure Draw
+           (This       : in Shared_Image;
+            X, Y, W, H : in Integer;
+            CX, CY     : in Integer := 0) is
+    begin
+        fl_shared_image_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;
+
+
+    procedure Draw
+           (This : in Shared_Image;
+            X, Y : in Integer) is
+    begin
+        fl_shared_image_draw2
+           (This.Void_Ptr,
+            Interfaces.C.int (X),
+            Interfaces.C.int (Y));
+    end Draw;
+
+
+end FLTK.Images.Shared;
+
diff --git a/src/fltk-images-shared.ads b/src/fltk-images-shared.ads
new file mode 100644
index 0000000..9214c8d
--- /dev/null
+++ b/src/fltk-images-shared.ads
@@ -0,0 +1,107 @@
+
+
+with
+
+    FLTK.Images.RGB;
+
+
+package FLTK.Images.Shared is
+
+
+    type Shared_Image is new Image with private;
+
+    type Scaling_Kind is (Nearest, Bilinear);
+
+
+
+
+    package Forge is
+
+        function Create
+               (Filename : in String;
+                W, H     : in Integer)
+            return Shared_Image;
+
+        function Create
+               (From : in FLTK.Images.RGB.RGB_Image'Class)
+            return Shared_Image;
+
+        function Find
+               (Name : in String;
+                W, H : in Integer := 0)
+            return Shared_Image;
+
+    end Forge;
+
+
+
+
+    function Copy
+           (This          : in Shared_Image;
+            Width, Height : in Natural)
+        return Shared_Image'Class;
+
+    function Copy
+           (This : in Shared_Image)
+        return Shared_Image'Class;
+
+
+
+
+    procedure Color_Average
+           (This   : in out Shared_Image;
+            Col    : in     Color;
+            Amount : in     Blend);
+
+    procedure Desaturate
+           (This : in out Shared_Image);
+
+
+
+
+    function Name
+           (This : in Shared_Image)
+        return String;
+
+    procedure Reload
+           (This : in out Shared_Image);
+
+    procedure Uncache
+           (This : in out Shared_Image);
+
+
+
+
+    procedure Set_Scaling_Algorithm
+           (To : in Scaling_Kind);
+
+    procedure Scale
+           (This         : in out Shared_Image;
+            W, H         : in     Integer;
+            Proportional : in     Boolean := True;
+            Can_Expand   : in     Boolean := False);
+
+
+
+
+    procedure Draw
+           (This       : in Shared_Image;
+            X, Y, W, H : in Integer;
+            CX, CY     : in Integer := 0);
+
+    procedure Draw
+           (This : in Shared_Image;
+            X, Y : in Integer);
+
+
+private
+
+
+    type Shared_Image is new Image with null record;
+
+    overriding procedure Finalize
+           (This : in out Shared_Image);
+
+
+end FLTK.Images.Shared;
+