Fl_Display_Device Binding Map

From a8967c654b6ee09dce89fe83bcafff2181a1952f Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Tue, 24 Dec 2024 18:51:07 +1300 Subject: Added Fl_Display_Device --- doc/fl_display_device.html | 112 +++++++++++++++++++++++++++++++++ doc/index.html | 3 +- progress.txt | 2 +- src/c_fl_display_device.cpp | 29 +++++++++ src/c_fl_display_device.h | 23 +++++++ src/c_fl_surface.cpp | 50 --------------- src/c_fl_surface.h | 26 -------- src/c_fl_surface_device.cpp | 54 ++++++++++++++++ src/c_fl_surface_device.h | 27 ++++++++ src/fltk-devices-surface-display.adb | 118 +++++++++++++++++++++++++++++++++++ src/fltk-devices-surface-display.ads | 53 ++++++++++++++++ src/fltk-devices-surface.adb | 56 ++++++++++------- src/fltk-devices-surface.ads | 3 - 13 files changed, 454 insertions(+), 102 deletions(-) create mode 100644 doc/fl_display_device.html create mode 100644 src/c_fl_display_device.cpp create mode 100644 src/c_fl_display_device.h delete mode 100644 src/c_fl_surface.cpp delete mode 100644 src/c_fl_surface.h create mode 100644 src/c_fl_surface_device.cpp create mode 100644 src/c_fl_surface_device.h create mode 100644 src/fltk-devices-surface-display.adb create mode 100644 src/fltk-devices-surface-display.ads diff --git a/doc/fl_display_device.html b/doc/fl_display_device.html new file mode 100644 index 0000000..7805527 --- /dev/null +++ b/doc/fl_display_device.html @@ -0,0 +1,112 @@ + + + + + + Fl_Display_Device Binding Map + + + + + + +

Fl_Display_Device Binding Map

+ + +Back to Index + + + + + + + + + + +

Package name
Fl_Display_Device	FLTK.Devices.Surface.Display

+ + + + + + + + + + + + + + + + +

Types
Fl_Display_Device	Display_Device
	Display_Device_Reference

+ + + + + + + + + + + +

Static Attributes
+static const char * class_id = "Fl_Display_Device"; +	Use runtime tag checks instead

+ + + + + + + + + + + +

Constructors
+Fl_Display_Device(Fl_Graphics_Driver *graphics_driver); +	+function Create + (Graphics : in out FLTK.Devices.Graphics.Graphics_Driver) + return Display_Device; +

+ + + + + + + + + + + +

Functions and Procedures
+const char * class_name(); +	Use runtime tag checks instead

+ + + + + + + + + + + +

Static Functions and Procedures
+static Fl_Display_Device * display_device(); +	+function Get_Platform_Display + return Display_Device_Reference; +

+ + + + + diff --git a/doc/index.html b/doc/index.html index 01b4bc7..6157396 100644 --- a/doc/index.html +++ b/doc/index.html @@ -39,7 +39,7 @@

Fl_Display_Device

@@ -141,6 +141,7 @@

FLTK.Devices.Graphics

FLTK.Devices.Surface

FLTK.Devices.Surface.Copy

FLTK.Devices.Surface.Display

FLTK.Devices.Surface.Image

FLTK.Devices.Surface.Paged

FLTK.Devices.Surface.Paged.Printers

diff --git a/progress.txt b/progress.txt index 8a0cb74..73518ac 100644 --- a/progress.txt +++ b/progress.txt @@ -17,6 +17,7 @@ FLTK.Asks FLTK.Devices FLTK.Devices.Surface FLTK.Devices.Surface.Copy +FLTK.Devices.Surface.Display FLTK.Devices.Surface.Image FLTK.Devices.Surface.Paged FLTK.Devices.Surface.Paged.Printers @@ -133,7 +134,6 @@ Fl_Graphics_Driver / FLTK.Devices.Graphics To-Do: -Fl_Display_Device Fl_GDI_Graphics_Driver Fl_GDI_Printer_Graphics_Driver Fl_Glut_Window diff --git a/src/c_fl_display_device.cpp b/src/c_fl_display_device.cpp new file mode 100644 index 0000000..9c88151 --- /dev/null +++ b/src/c_fl_display_device.cpp @@ -0,0 +1,29 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include +#include "c_fl_display_device.h" + + + + +DISPLAYDEVICE new_fl_display_device(void * g) { + Fl_Display_Device *d = new Fl_Display_Device(reinterpret_cast(g)); + return d; +} + +void free_fl_display_device(DISPLAYDEVICE d) { + delete reinterpret_cast(d); +} + + + + +DISPLAYDEVICE fl_display_device_display_device() { + return Fl_Display_Device::display_device(); +} + + diff --git a/src/c_fl_display_device.h b/src/c_fl_display_device.h new file mode 100644 index 0000000..1cf530c --- /dev/null +++ b/src/c_fl_display_device.h @@ -0,0 +1,23 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef FL_DISPLAY_DEVICE_GUARD +#define FL_DISPLAY_DEVICE_GUARD + + +typedef void* DISPLAYDEVICE; + + +extern "C" DISPLAYDEVICE new_fl_display_device(void * g); +extern "C" void free_fl_display_device(DISPLAYDEVICE d); + + +extern "C" DISPLAYDEVICE fl_display_device_display_device(); + + +#endif + + diff --git a/src/c_fl_surface.cpp b/src/c_fl_surface.cpp deleted file mode 100644 index 9fb21ca..0000000 --- a/src/c_fl_surface.cpp +++ /dev/null @@ -1,50 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#include -#include "c_fl_surface.h" - - - - -class My_Surface_Device : public Fl_Surface_Device { -public: - using Fl_Surface_Device::Fl_Surface_Device; - friend SURFACE new_fl_surface(void * g); -}; - - - - -SURFACE new_fl_surface(void * g) { - My_Surface_Device *s = new My_Surface_Device(reinterpret_cast(g)); - return s; -} - -void free_fl_surface(SURFACE s) { - delete reinterpret_cast(s); -} - - - - -void fl_surface_set_current(SURFACE s) { - // virtual so disable dispatch - reinterpret_cast(s)->Fl_Surface_Device::set_current(); -} - -SURFACE fl_surface_get_surface(void) { - return Fl_Surface_Device::surface(); -} - - - - -void fl_surface_set_driver(SURFACE s, void * g) { - reinterpret_cast(s)->driver(reinterpret_cast(g)); -} - - diff --git a/src/c_fl_surface.h b/src/c_fl_surface.h deleted file mode 100644 index bdbfe2d..0000000 --- a/src/c_fl_surface.h +++ /dev/null @@ -1,26 +0,0 @@ - - -// Programmed by Jedidiah Barber -// Released into the public domain - - -#ifndef FL_SURFACE_GUARD -#define FL_SURFACE_GUARD - - -typedef void* SURFACE; - - -extern "C" SURFACE new_fl_surface(void * g); -extern "C" void free_fl_surface(SURFACE s); - - -extern "C" void fl_surface_set_current(SURFACE s); -extern "C" SURFACE fl_surface_get_surface(void); - - -extern "C" void fl_surface_set_driver(SURFACE s, void * g); - - -#endif - diff --git a/src/c_fl_surface_device.cpp b/src/c_fl_surface_device.cpp new file mode 100644 index 0000000..34b2bac --- /dev/null +++ b/src/c_fl_surface_device.cpp @@ -0,0 +1,54 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include +#include "c_fl_surface_device.h" + + + + +class My_Surface_Device : public Fl_Surface_Device { +public: + using Fl_Surface_Device::Fl_Surface_Device; + friend SURFACEDEVICE new_fl_surface_device(void * g); +}; + + + + +SURFACEDEVICE new_fl_surface_device(void * g) { + My_Surface_Device *s = new My_Surface_Device(reinterpret_cast(g)); + return s; +} + +void free_fl_surface_device(SURFACEDEVICE s) { + delete reinterpret_cast(s); +} + + + + +void fl_surface_device_set_current(SURFACEDEVICE s) { + // virtual so disable dispatch + reinterpret_cast(s)->Fl_Surface_Device::set_current(); +} + +SURFACEDEVICE fl_surface_device_get_surface(void) { + return Fl_Surface_Device::surface(); +} + + + + +void * fl_surface_device_get_driver(SURFACEDEVICE s) { + return reinterpret_cast(s)->driver(); +} + +void fl_surface_device_set_driver(SURFACEDEVICE s, void * g) { + reinterpret_cast(s)->driver(reinterpret_cast(g)); +} + + diff --git a/src/c_fl_surface_device.h b/src/c_fl_surface_device.h new file mode 100644 index 0000000..fa5946a --- /dev/null +++ b/src/c_fl_surface_device.h @@ -0,0 +1,27 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef FL_SURFACE_DEVICE_GUARD +#define FL_SURFACE_DEVICE_GUARD + + +typedef void* SURFACEDEVICE; + + +extern "C" SURFACEDEVICE new_fl_surface_device(void * g); +extern "C" void free_fl_surface_device(SURFACEDEVICE s); + + +extern "C" void fl_surface_device_set_current(SURFACEDEVICE s); +extern "C" SURFACEDEVICE fl_surface_device_get_surface(void); + + +extern "C" void * fl_surface_device_get_driver(SURFACEDEVICE s); +extern "C" void fl_surface_device_set_driver(SURFACEDEVICE s, void * g); + + +#endif + diff --git a/src/fltk-devices-surface-display.adb b/src/fltk-devices-surface-display.adb new file mode 100644 index 0000000..ad35012 --- /dev/null +++ b/src/fltk-devices-surface-display.adb @@ -0,0 +1,118 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package body FLTK.Devices.Surface.Display is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_display_device + (G : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, new_fl_display_device, "new_fl_display_device"); + pragma Inline (new_fl_display_device); + + procedure free_fl_display_device + (D : in Storage.Integer_Address); + pragma Import (C, free_fl_display_device, "free_fl_display_device"); + pragma Inline (free_fl_display_device); + + + + + function fl_display_device_display_device + return Storage.Integer_Address; + pragma Import (C, fl_display_device_display_device, "fl_display_device_display_device"); + pragma Inline (fl_display_device_display_device); + + + + + 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); + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Finalize + (This : in out Display_Device) is + begin + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_display_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 Display_Device is + begin + return This : Display_Device do + This.Void_Ptr := new_fl_display_device (Wrapper (Graphics).Void_Ptr); + This.My_Driver := Graphics'Unchecked_Access; + end return; + end Create; + + end Forge; + + + + + ------------------------- + -- Static Attributes -- + ------------------------- + + Platform_Display : aliased Display_Device; + Platform_Graphics : aliased FLTK.Devices.Graphics.Graphics_Driver; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + function Get_Platform_Display + return Display_Device_Reference is + begin + return Ref : Display_Device_Reference (Data => Platform_Display'Access); + end Get_Platform_Display; + + +begin + + + Platform_Display.Void_Ptr := fl_display_device_display_device; + Platform_Display.Needs_Dealloc := False; + + Wrapper (Platform_Graphics).Void_Ptr := + fl_surface_device_get_driver (Platform_Display.Void_Ptr); + Wrapper (Platform_Graphics).Needs_Dealloc := False; + + Platform_Display.My_Driver := Platform_Graphics'Access; + + +end FLTK.Devices.Surface.Display; + + diff --git a/src/fltk-devices-surface-display.ads b/src/fltk-devices-surface-display.ads new file mode 100644 index 0000000..b581be7 --- /dev/null +++ b/src/fltk-devices-surface-display.ads @@ -0,0 +1,53 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + FLTK.Devices.Graphics; + + +package FLTK.Devices.Surface.Display is + + + type Display_Device is new Surface_Device with private; + + type Display_Device_Reference (Data : not null access Display_Device'Class) is + limited null record with Implicit_Dereference => Data; + + + + + package Forge is + + -- Docs say you shouldn't ever need to use this, but it's here anyway. + function Create + (Graphics : in out FLTK.Devices.Graphics.Graphics_Driver) + return Display_Device; + + end Forge; + + + + + function Get_Platform_Display + return Display_Device_Reference; + + +private + + + type Display_Device is new Surface_Device with null record; + + overriding procedure Finalize + (This : in out Display_Device); + + + pragma Inline (Get_Platform_Display); + + +end FLTK.Devices.Surface.Display; + + diff --git a/src/fltk-devices-surface.adb b/src/fltk-devices-surface.adb index 8ae558d..a6ef6cc 100644 --- a/src/fltk-devices-surface.adb +++ b/src/fltk-devices-surface.adb @@ -11,37 +11,43 @@ package body FLTK.Devices.Surface is -- Functions From C -- ------------------------ - function new_fl_surface + function new_fl_surface_device (G : in Storage.Integer_Address) return Storage.Integer_Address; - pragma Import (C, new_fl_surface, "new_fl_surface"); - pragma Inline (new_fl_surface); + pragma Import (C, new_fl_surface_device, "new_fl_surface_device"); + pragma Inline (new_fl_surface_device); - procedure free_fl_surface + procedure free_fl_surface_device (S : in Storage.Integer_Address); - pragma Import (C, free_fl_surface, "free_fl_surface"); - pragma Inline (free_fl_surface); + pragma Import (C, free_fl_surface_device, "free_fl_surface_device"); + pragma Inline (free_fl_surface_device); - procedure fl_surface_set_current + procedure fl_surface_device_set_current (S : in Storage.Integer_Address); - pragma Import (C, fl_surface_set_current, "fl_surface_set_current"); - pragma Inline (fl_surface_set_current); + pragma Import (C, fl_surface_device_set_current, "fl_surface_device_set_current"); + pragma Inline (fl_surface_device_set_current); - function fl_surface_get_surface + function fl_surface_device_get_surface return Storage.Integer_Address; - pragma Import (C, fl_surface_get_surface, "fl_surface_get_surface"); - pragma Inline (fl_surface_get_surface); + pragma Import (C, fl_surface_device_get_surface, "fl_surface_device_get_surface"); + pragma Inline (fl_surface_device_get_surface); - procedure fl_surface_set_driver + 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_set_driver, "fl_surface_set_driver"); - pragma Inline (fl_surface_set_driver); + pragma Import (C, fl_surface_device_set_driver, "fl_surface_device_set_driver"); + pragma Inline (fl_surface_device_set_driver); @@ -54,7 +60,7 @@ package body FLTK.Devices.Surface is (This : in out Surface_Device) is begin if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then - free_fl_surface (This.Void_Ptr); + free_fl_surface_device (This.Void_Ptr); This.Void_Ptr := Null_Pointer; end if; end Finalize; @@ -73,7 +79,7 @@ package body FLTK.Devices.Surface is return Surface_Device is begin return This : Surface_Device do - This.Void_Ptr := new_fl_surface (Wrapper (Graphics).Void_Ptr); + This.Void_Ptr := new_fl_surface_device (Wrapper (Graphics).Void_Ptr); This.My_Driver := Graphics'Unchecked_Access; end return; end Create; @@ -87,7 +93,9 @@ package body FLTK.Devices.Surface is -- Static Attributes -- ------------------------- - Original_Surface : aliased Surface_Device; + Original_Surface : aliased Surface_Device; + Original_Graphics : aliased FLTK.Devices.Graphics.Graphics_Driver; + Current_Surface : access Surface_Device'Class := Original_Surface'Access; @@ -114,7 +122,7 @@ package body FLTK.Devices.Surface is procedure Set_Current (This : in out Surface_Device) is begin - fl_surface_set_current (This.Void_Ptr); + fl_surface_device_set_current (This.Void_Ptr); This.Set_Current_Bookkeep; end Set_Current; @@ -149,7 +157,7 @@ package body FLTK.Devices.Surface is (This : in out Surface_Device; Driver : in out FLTK.Devices.Graphics.Graphics_Driver'Class) is begin - fl_surface_set_driver (This.Void_Ptr, Wrapper (Driver).Void_Ptr); + fl_surface_device_set_driver (This.Void_Ptr, Wrapper (Driver).Void_Ptr); This.My_Driver := Driver'Unchecked_Access; end Set_Driver; @@ -157,9 +165,15 @@ package body FLTK.Devices.Surface is begin - Original_Surface.Void_Ptr := fl_surface_get_surface; + 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; diff --git a/src/fltk-devices-surface.ads b/src/fltk-devices-surface.ads index 68d0df7..f70d1e8 100644 --- a/src/fltk-devices-surface.ads +++ b/src/fltk-devices-surface.ads @@ -12,9 +12,6 @@ with 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 -- cgit