From b3f9e96403aa5cb9d7db2330aa579356d1d58b6f Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Mon, 23 Dec 2024 17:02:34 +1300 Subject: Tweaked the names of Surface_Device subhierarchy --- src/fltk-devices-surface.ads | 65 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 65 insertions(+) create mode 100644 src/fltk-devices-surface.ads (limited to 'src/fltk-devices-surface.ads') diff --git a/src/fltk-devices-surface.ads b/src/fltk-devices-surface.ads new file mode 100644 index 0000000..8ca367c --- /dev/null +++ b/src/fltk-devices-surface.ads @@ -0,0 +1,65 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + FLTK.Devices.Graphics; + + +package FLTK.Devices.Surface is + + + pragma Elaborate_Body (FLTK.Devices.Surface); + + + + + type Surface_Device is new Device with private; + + type Surface_Device_Reference (Data : not null access Surface_Device'Class) is + limited null record with Implicit_Dereference => Data; + + + + + package Forge is + + function Create + (Graphics : in out FLTK.Devices.Graphics.Graphics_Driver) + return Surface_Device; + + end Forge; + + + + + function Get_Current + return access Surface_Device'Class; + + procedure Set_Current + (This : in out Surface_Device); + + +private + + + type Surface_Device is new Device with null record; + + overriding procedure Finalize + (This : in out Surface_Device); + + + Original_Surface : aliased Surface_Device; + Current_Ptr : access Surface_Device'Class := Original_Surface'Access; + + + pragma Inline (Get_Current); + pragma Inline (Set_Current); + + +end FLTK.Devices.Surface; + + -- cgit