summaryrefslogtreecommitdiff
path: root/src/fltk-devices-surface.adb
diff options
context:
space:
mode:
authorJedidiah Barber <contact@jedbarber.id.au>2025-01-21 21:04:54 +1300
committerJedidiah Barber <contact@jedbarber.id.au>2025-01-21 21:04:54 +1300
commitb4438b2fbe895694be98e6e8426103deefc51448 (patch)
tree760d86cd7c06420a91dad102cc9546aee73146fc /src/fltk-devices-surface.adb
parenta4703a65b015140cd4a7a985db66264875ade734 (diff)
Split public API and private implementation files into different directories
Diffstat (limited to 'src/fltk-devices-surface.adb')
-rw-r--r--src/fltk-devices-surface.adb180
1 files changed, 0 insertions, 180 deletions
diff --git a/src/fltk-devices-surface.adb b/src/fltk-devices-surface.adb
deleted file mode 100644
index a6ef6cc..0000000
--- a/src/fltk-devices-surface.adb
+++ /dev/null
@@ -1,180 +0,0 @@
-
-
--- Programmed by Jedidiah Barber
--- Released into the public domain
-
-
-package body FLTK.Devices.Surface is
-
-
- ------------------------
- -- Functions From C --
- ------------------------
-
- function new_fl_surface_device
- (G : in Storage.Integer_Address)
- return Storage.Integer_Address;
- pragma Import (C, new_fl_surface_device, "new_fl_surface_device");
- pragma Inline (new_fl_surface_device);
-
- procedure free_fl_surface_device
- (S : in Storage.Integer_Address);
- pragma Import (C, free_fl_surface_device, "free_fl_surface_device");
- pragma Inline (free_fl_surface_device);
-
-
-
-
- procedure fl_surface_device_set_current
- (S : in Storage.Integer_Address);
- pragma Import (C, fl_surface_device_set_current, "fl_surface_device_set_current");
- pragma Inline (fl_surface_device_set_current);
-
- function fl_surface_device_get_surface
- return Storage.Integer_Address;
- pragma Import (C, fl_surface_device_get_surface, "fl_surface_device_get_surface");
- pragma Inline (fl_surface_device_get_surface);
-
-
-
-
- function fl_surface_device_get_driver
- (S : in Storage.Integer_Address)
- return Storage.Integer_Address;
- pragma Import (C, fl_surface_device_get_driver, "fl_surface_device_get_driver");
- pragma Inline (fl_surface_device_get_driver);
-
- procedure fl_surface_device_set_driver
- (S, G : in Storage.Integer_Address);
- pragma Import (C, fl_surface_device_set_driver, "fl_surface_device_set_driver");
- pragma Inline (fl_surface_device_set_driver);
-
-
-
-
- -------------------
- -- Destructors --
- -------------------
-
- procedure Finalize
- (This : in out Surface_Device) is
- begin
- if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
- free_fl_surface_device (This.Void_Ptr);
- This.Void_Ptr := Null_Pointer;
- end if;
- end Finalize;
-
-
-
-
- --------------------
- -- Constructors --
- --------------------
-
- 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_device (Wrapper (Graphics).Void_Ptr);
- This.My_Driver := Graphics'Unchecked_Access;
- end return;
- end Create;
-
- end Forge;
-
-
-
-
- -------------------------
- -- Static Attributes --
- -------------------------
-
- Original_Surface : aliased Surface_Device;
- Original_Graphics : aliased FLTK.Devices.Graphics.Graphics_Driver;
-
- Current_Surface : access Surface_Device'Class := Original_Surface'Access;
-
-
- procedure Set_Current_Bookkeep
- (Surface : in out Surface_Device'Class) is
- begin
- Current_Surface := Surface'Unchecked_Access;
- end Set_Current_Bookkeep;
-
-
-
-
- -----------------------
- -- API Subprograms --
- -----------------------
-
- function Get_Current
- return Surface_Device_Reference is
- begin
- return Ref : Surface_Device_Reference (Data => Current_Surface);
- end Get_Current;
-
-
- procedure Set_Current
- (This : in out Surface_Device) is
- begin
- fl_surface_device_set_current (This.Void_Ptr);
- This.Set_Current_Bookkeep;
- end Set_Current;
-
-
- function Get_Original
- return Surface_Device_Reference is
- begin
- return Ref : Surface_Device_Reference (Data => Original_Surface'Access);
- end Get_Original;
-
-
-
-
- function Has_Driver
- (This : in Surface_Device)
- return Boolean is
- begin
- return This.My_Driver /= null and then
- Wrapper (This.My_Driver.all).Void_Ptr /= Null_Pointer;
- end Has_Driver;
-
-
- function Get_Driver
- (This : in out Surface_Device)
- return FLTK.Devices.Graphics.Graphics_Driver_Reference is
- begin
- return Ref : FLTK.Devices.Graphics.Graphics_Driver_Reference (Data => This.My_Driver);
- end Get_Driver;
-
-
- procedure Set_Driver
- (This : in out Surface_Device;
- Driver : in out FLTK.Devices.Graphics.Graphics_Driver'Class) is
- begin
- fl_surface_device_set_driver (This.Void_Ptr, Wrapper (Driver).Void_Ptr);
- This.My_Driver := Driver'Unchecked_Access;
- end Set_Driver;
-
-
-begin
-
-
- Original_Surface.Void_Ptr := fl_surface_device_get_surface;
- Original_Surface.Needs_Dealloc := False;
-
- Wrapper (Original_Graphics).Void_Ptr :=
- fl_surface_device_get_driver (Original_Surface.Void_Ptr);
- Wrapper (Original_Graphics).Needs_Dealloc := False;
-
- Original_Surface.My_Driver := Original_Graphics'Access;
-
-
-end FLTK.Devices.Surface;
-
-