diff options
Diffstat (limited to 'src/fltk-devices-surfaces.adb')
-rw-r--r-- | src/fltk-devices-surfaces.adb | 96 |
1 files changed, 96 insertions, 0 deletions
diff --git a/src/fltk-devices-surfaces.adb b/src/fltk-devices-surfaces.adb new file mode 100644 index 0000000..a0c5042 --- /dev/null +++ b/src/fltk-devices-surfaces.adb @@ -0,0 +1,96 @@ + + +with + + System; + +use type + + System.Address; + + +package body FLTK.Devices.Surfaces is + + + function new_fl_surface + (G : in System.Address) + return System.Address; + pragma Import (C, new_fl_surface, "new_fl_surface"); + + procedure free_fl_surface + (S : in System.Address); + pragma Import (C, free_fl_surface, "free_fl_surface"); + + + + + procedure fl_surface_set_current + (S : in System.Address); + pragma Import (C, fl_surface_set_current, "fl_surface_set_current"); + + function fl_surface_get_surface + return System.Address; + pragma Import (C, fl_surface_get_surface, "fl_surface_get_surface"); + + + + + procedure Finalize + (This : in out Surface_Device) is + begin + if This.Void_Ptr /= System.Null_Address and then + This in Surface_Device'Class + then + if This.Needs_Dealloc then + free_fl_surface (This.Void_Ptr); + end if; + This.Void_Ptr := System.Null_Address; + end if; + Finalize (Device (This)); + end Finalize; + + + + + package body Forge is + + function Create + (Graphics : in out FLTK.Devices.Graphics.Graphics_Driver) + return Surface_Device is + begin + return This : Surface_Device do + This.Void_Ptr := new_fl_surface (Wrapper (Graphics).Void_Ptr); + end return; + end Create; + + end Forge; + + + + + function Get_Current + return access Surface_Device is + begin + return Current_Ptr; + end Get_Current; + + + procedure Set_Current + (This : in out Surface_Device) is + begin + fl_surface_set_current (This.Void_Ptr); + Current_Ptr := This'Unchecked_Access; + end Set_Current; + + + + +begin + + + Original_Surface.Void_Ptr := fl_surface_get_surface; + Original_Surface.Needs_Dealloc := False; + + +end FLTK.Devices.Surfaces; + |