From 17150a9322c650f804e7f9682a9beba573a8c9b7 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Tue, 27 Mar 2018 12:32:42 +1100 Subject: Added FLTK.Devices.Surfaces.Image --- src/c_fl_image_surface.cpp | 45 +++++++++++ src/c_fl_image_surface.h | 31 ++++++++ src/fltk-devices-surfaces-image.adb | 152 ++++++++++++++++++++++++++++++++++++ src/fltk-devices-surfaces-image.ads | 74 ++++++++++++++++++ 4 files changed, 302 insertions(+) create mode 100644 src/c_fl_image_surface.cpp create mode 100644 src/c_fl_image_surface.h create mode 100644 src/fltk-devices-surfaces-image.adb create mode 100644 src/fltk-devices-surfaces-image.ads (limited to 'src') diff --git a/src/c_fl_image_surface.cpp b/src/c_fl_image_surface.cpp new file mode 100644 index 0000000..eb8d26e --- /dev/null +++ b/src/c_fl_image_surface.cpp @@ -0,0 +1,45 @@ + + +#include +#include +#include +#include "c_fl_image_surface.h" + + + + +IMAGE_SURFACE new_fl_image_surface(int w, int h, int r) { + Fl_Image_Surface *s = new Fl_Image_Surface(w,h,r); + return s; +} + +void free_fl_image_surface(IMAGE_SURFACE s) { + delete reinterpret_cast(s); +} + + + + +void fl_image_surface_draw(IMAGE_SURFACE s, void * w, int dx, int dy) { + reinterpret_cast(s)->draw(reinterpret_cast(w),dx,dy); +} + +void fl_image_surface_draw_decorated_window(IMAGE_SURFACE s, void * w, int dx, int dy) { + reinterpret_cast(s)->draw_decorated_window(reinterpret_cast(w),dx,dy); +} + + + + +void * fl_image_surface_image(IMAGE_SURFACE s) { + return reinterpret_cast(s)->image(); +} + + + + +void fl_image_surface_set_current(IMAGE_SURFACE s) { + reinterpret_cast(s)->set_current(); +} + + diff --git a/src/c_fl_image_surface.h b/src/c_fl_image_surface.h new file mode 100644 index 0000000..3ecafd3 --- /dev/null +++ b/src/c_fl_image_surface.h @@ -0,0 +1,31 @@ + + +#ifndef FL_IMAGE_SURFACE_GUARD +#define FL_IMAGE_SURFACE_GUARD + + + + +typedef void* IMAGE_SURFACE; + + + + +extern "C" IMAGE_SURFACE new_fl_image_surface(int w, int h, int r); +extern "C" void free_fl_image_surface(IMAGE_SURFACE s); + + + + +extern "C" void fl_image_surface_draw(IMAGE_SURFACE s, void * w, int dx, int dy); +extern "C" void fl_image_surface_draw_decorated_window(IMAGE_SURFACE s, void * w, int dx, int dy); + + +extern "C" void * fl_image_surface_image(IMAGE_SURFACE s); + + +extern "C" void fl_image_surface_set_current(IMAGE_SURFACE s); + + +#endif + diff --git a/src/fltk-devices-surfaces-image.adb b/src/fltk-devices-surfaces-image.adb new file mode 100644 index 0000000..0621e39 --- /dev/null +++ b/src/fltk-devices-surfaces-image.adb @@ -0,0 +1,152 @@ + + +with + + Interfaces.C, + System; + +use type + + System.Address; + + +package body FLTK.Devices.Surfaces.Image is + + + function new_fl_image_surface + (W, H, R : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_image_surface, "new_fl_image_surface"); + + procedure free_fl_image_surface + (S : in System.Address); + pragma Import (C, free_fl_image_surface, "free_fl_image_surface"); + + + + + procedure fl_image_surface_draw + (S, I : in System.Address; + OX, OY : in Interfaces.C.int); + pragma Import (C, fl_image_surface_draw, "fl_image_surface_draw"); + + procedure fl_image_surface_draw_decorated_window + (S, I : in System.Address; + OX, OY : in Interfaces.C.int); + pragma Import (C, fl_image_surface_draw_decorated_window, + "fl_image_surface_draw_decorated_window"); + + + + + function fl_image_surface_image + (S : in System.Address) + return System.Address; + pragma Import (C, fl_image_surface_image, "fl_image_surface_image"); + + + + + procedure fl_image_surface_set_current + (S : in System.Address); + pragma Import (C, fl_image_surface_set_current, "fl_image_surface_set_current"); + + + + + procedure Finalize + (This : in out Image_Surface) is + begin + if This.Void_Ptr /= System.Null_Address and then + This in Image_Surface'Class + then + free_fl_image_surface (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; + end if; + Finalize (Surface_Device (This)); + end Finalize; + + + + + package body Forge is + + function Create + (W, H : in Integer; + Highres : in Boolean := False) + return Image_Surface is + begin + return This : Image_Surface do + This.Void_Ptr := new_fl_image_surface + (Interfaces.C.int (W), + Interfaces.C.int (H), + Boolean'Pos (Highres)); + This.High := Highres; + end return; + end Create; + + end Forge; + + + + + function Is_Highres + (This : in Image_Surface) + return Boolean is + begin + return This.High; + end Is_Highres; + + + + + procedure Draw_Widget + (This : in out Image_Surface; + Item : in FLTK.Widgets.Widget'Class; + Offset_X, Offset_Y : in Integer := 0) is + begin + fl_image_surface_draw + (This.Void_Ptr, + Wrapper (Item).Void_Ptr, + Interfaces.C.int (Offset_X), + Interfaces.C.int (Offset_Y)); + end Draw_Widget; + + + procedure Draw_Decorated_Window + (This : in out Image_Surface; + Item : in FLTK.Widgets.Groups.Windows.Window'Class; + Offset_X, Offset_Y : in Integer := 0) is + begin + fl_image_surface_draw_decorated_window + (This.Void_Ptr, + Wrapper (Item).Void_Ptr, + Interfaces.C.int (Offset_X), + Interfaces.C.int (Offset_Y)); + end Draw_Decorated_Window; + + + + + function Get_Image + (This : in Image_Surface) + return FLTK.Images.RGB.RGB_Image is + begin + return Img : FLTK.Images.RGB.RGB_Image do + Wrapper (Img).Void_Ptr := fl_image_surface_image (This.Void_Ptr); + end return; + end Get_Image; + + + + + procedure Set_Current + (This : in out Image_Surface) is + begin + fl_image_surface_set_current (This.Void_Ptr); + Current_Ptr := This'Unchecked_Access; + end Set_Current; + + +end FLTK.Devices.Surfaces.Image; + diff --git a/src/fltk-devices-surfaces-image.ads b/src/fltk-devices-surfaces-image.ads new file mode 100644 index 0000000..1c7e383 --- /dev/null +++ b/src/fltk-devices-surfaces-image.ads @@ -0,0 +1,74 @@ + + +with + + FLTK.Images.RGB, + FLTK.Widgets.Groups.Windows; + + +package FLTK.Devices.Surfaces.Image is + + + type Image_Surface is new Surface_Device with private; + + + + + package Forge is + + function Create + (W, H : in Integer; + Highres : in Boolean := False) + return Image_Surface; + + end Forge; + + + + + function Is_Highres + (This : in Image_Surface) + return Boolean; + + + + + procedure Draw_Widget + (This : in out Image_Surface; + Item : in FLTK.Widgets.Widget'Class; + Offset_X, Offset_Y : in Integer := 0); + + procedure Draw_Decorated_Window + (This : in out Image_Surface; + Item : in FLTK.Widgets.Groups.Windows.Window'Class; + Offset_X, Offset_Y : in Integer := 0); + + + + + function Get_Image + (This : in Image_Surface) + return FLTK.Images.RGB.RGB_Image; + + -- Get_Highres_Image + + + + + procedure Set_Current + (This : in out Image_Surface); + + +private + + + type Image_Surface is new Surface_Device with record + High : Boolean := False; + end record; + + overriding procedure Finalize + (This : in out Image_Surface); + + +end FLTK.Devices.Surfaces.Image; + -- cgit