with Interfaces.C.Strings, System; use type Interfaces.C.Strings.chars_ptr, 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"); pragma Inline (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"); pragma Inline (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"); pragma Inline (fl_shared_image_find); procedure fl_shared_image_release (I : in System.Address); pragma Import (C, fl_shared_image_release, "fl_shared_image_release"); pragma Inline (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"); pragma Inline (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"); pragma Inline (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"); pragma Inline (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"); pragma Inline (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"); pragma Inline (fl_shared_image_name); procedure fl_shared_image_reload (I : in System.Address); pragma Import (C, fl_shared_image_reload, "fl_shared_image_reload"); pragma Inline (fl_shared_image_reload); procedure fl_shared_image_scaling_algorithm (A : in Interfaces.C.int); pragma Import (C, fl_shared_image_scaling_algorithm, "fl_shared_image_scaling_algorithm"); pragma Inline (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"); pragma Inline (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"); pragma Inline (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"); pragma Inline (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 Ptr : Interfaces.C.Strings.chars_ptr := fl_shared_image_name (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; else return Interfaces.C.Strings.Value (Ptr); end if; end Name; procedure Reload (This : in out Shared_Image) is begin fl_shared_image_reload (This.Void_Ptr); end Reload; 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;