summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJedidiah Barber <contact@jedbarber.id.au>2024-02-21 18:48:49 +1300
committerJedidiah Barber <contact@jedbarber.id.au>2024-02-21 18:48:49 +1300
commitfbec75e5847cace1edd5b10e16176f1fba18f969 (patch)
treeba196482bd0e7572e1ed9c442070554fa01c5691
parentc5b296567825c48d3658d62f01ec770449379e85 (diff)
Fl_Tiled_Image binding added
-rw-r--r--doc/fl_tiled_image.html148
-rw-r--r--doc/index.html3
-rw-r--r--progress.txt4
-rw-r--r--src/c_fl_tiled_image.cpp60
-rw-r--r--src/c_fl_tiled_image.h34
-rw-r--r--src/fltk-images-tiled.adb233
-rw-r--r--src/fltk-images-tiled.ads112
-rw-r--r--src/fltk-images.adb4
8 files changed, 594 insertions, 4 deletions
diff --git a/doc/fl_tiled_image.html b/doc/fl_tiled_image.html
new file mode 100644
index 0000000..7cbc7ad
--- /dev/null
+++ b/doc/fl_tiled_image.html
@@ -0,0 +1,148 @@
+
+<!DOCTYPE html>
+
+<html lang="en">
+ <head>
+ <meta charset="utf-8">
+ <title>Fl_Tiled_Image Binding Map</title>
+ <link href="map.css" rel="stylesheet">
+ </head>
+
+ <body>
+
+
+<h2>Fl_Tiled_Image Binding Map</h2>
+
+
+<a href="index.html">Back to Index</a>
+
+
+<table class="package">
+ <tr><th colspan="2">Package name</th></tr>
+
+ <tr>
+ <td>Fl_Tiled_Image</td>
+ <td>FLTK.Images.Tiled</td>
+ </tr>
+
+</table>
+
+
+
+<table class="type">
+ <tr><th colspan="2">Types</th></tr>
+
+ <tr>
+ <td>Fl_Tiled_Image</td>
+ <td>Tiled_Image</td>
+ </tr>
+
+ <tr>
+ <td>&nbsp;</td>
+ <td>Tiled_Image_Reference</td>
+ </tr>
+
+</table>
+
+
+
+<table class="function">
+ <tr><th colspan="2">Functions and Procedures</th></tr>
+
+ <tr>
+<td><pre>
+Fl_Tiled_Image(Fl_Image *i, int W=0, int H=0);
+</pre></td>
+<td><pre>
+function Create
+ (From : in out Image'Class;
+ W, H : in Integer := 0)
+ return Tiled_Image;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+virtual void color_average(Fl_Color c, float i);
+</pre></td>
+<td><pre>
+procedure Color_Average
+ (This : in out Tiled_Image;
+ Hue : in Color;
+ Amount : in Blend);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+Fl_Image * copy();
+</pre></td>
+<td><pre>
+function Copy
+ (This : in Tiled_Image)
+ return Tiled_Image'Class;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+virtual Fl_Image * copy(int W, int H);
+</pre></td>
+<td><pre>
+function Copy
+ (This : in Tiled_Image;
+ Width, Height : in Natural)
+ return Tiled_Image'Class;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+virtual void desaturate();
+</pre></td>
+<td><pre>
+procedure Desaturate
+ (This : in out Tiled_Image);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void draw(int X, int Y);
+</pre></td>
+<td><pre>
+procedure Draw
+ (This : in Tiled_Image;
+ X, Y : in Integer);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+virtual void draw(int X, int Y, int W, int H, int cx, int cy);
+</pre></td>
+<td><pre>
+procedure Draw
+ (This : in Tiled_Image;
+ X, Y, W, H : in Integer;
+ CX, CY : in Integer);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+Fl_Image * image();
+</pre></td>
+<td><pre>
+function Tile
+ (This : in out Tiled_Image)
+ return Image_Reference;
+</pre></td>
+ </tr>
+
+</table>
+
+
+ </body>
+</html>
+
diff --git a/doc/index.html b/doc/index.html
index 75d659f..f729db2 100644
--- a/doc/index.html
+++ b/doc/index.html
@@ -116,7 +116,7 @@
<li><a href="fl_text_display.html">Fl_Text_Display</a></li>
<li><a href="fl_text_editor.html">Fl_Text_Editor</a></li>
<li><a href="fl_tile.html">Fl_Tile</a></li>
- <li>Fl_Tiled_Image</li>
+ <li><a href="fl_tiled_image.html">Fl_Tiled_Image</a></li>
<li><a href="fl_toggle_button.html">Fl_Toggle_Button</a></li>
<li><a href="fl_tooltip.html">Fl_Tooltip</a></li>
<li>Fl_Tree</li>
@@ -159,6 +159,7 @@
<li><a href="fl_png_image.html">FLTK.Images.RGB.PNG</a></li>
<li><a href="fl_pnm_image.html">FLTK.Images.RGB.PNM</a></li>
<li><a href="fl_shared_image.html">FLTK.Images.Shared</a></li>
+ <li><a href="fl_tiled_image.html">FLTK.Images.Tiled</a></li>
<li><a href="fl_menu_item.html">FLTK.Menu_Items</a></li>
<li><a href="fl.html">FLTK.Screen</a></li>
<li><a href="fl.html">FLTK.Static</a></li>
diff --git a/progress.txt b/progress.txt
index 6ca018c..1cfb0be 100644
--- a/progress.txt
+++ b/progress.txt
@@ -5,7 +5,7 @@ Approximate Progress List
-Overall estimate: 81%
+Overall estimate: 82%
@@ -41,6 +41,7 @@ FLTK.Images.RGB.JPEG
FLTK.Images.RGB.PNG
FLTK.Images.RGB.PNM
FLTK.Images.Shared
+FLTK.Images.Tiled
FLTK.Menu_Items
FLTK.Screen
FLTK.Static
@@ -148,7 +149,6 @@ Fl_Postscript_File_Device
Fl_Select_Browser
Fl_Table
Fl_Table_Row
-Fl_Tiled_Image
Fl_Tree
diff --git a/src/c_fl_tiled_image.cpp b/src/c_fl_tiled_image.cpp
new file mode 100644
index 0000000..8d7ecde
--- /dev/null
+++ b/src/c_fl_tiled_image.cpp
@@ -0,0 +1,60 @@
+
+
+#include <FL/Fl_Tiled_Image.H>
+#include <FL/Fl_Image.H>
+#include "c_fl_tiled_image.h"
+
+
+
+
+TILED_IMAGE new_fl_tiled_image(void * i, int w, int h) {
+ Fl_Tiled_Image *t = new Fl_Tiled_Image(reinterpret_cast<Fl_Image*>(i), w, h);
+ return t;
+}
+
+void free_fl_tiled_image(TILED_IMAGE t) {
+ delete reinterpret_cast<Fl_Tiled_Image*>(t);
+}
+
+TILED_IMAGE fl_tiled_image_copy(TILED_IMAGE t, int w, int h) {
+ // virtual so disable dispatch
+ return reinterpret_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::copy(w, h);
+}
+
+TILED_IMAGE fl_tiled_image_copy2(TILED_IMAGE t) {
+ return reinterpret_cast<Fl_Tiled_Image*>(t)->copy();
+}
+
+
+
+
+void * fl_tiled_image_get_image(TILED_IMAGE t) {
+ return reinterpret_cast<Fl_Tiled_Image*>(t)->image();
+}
+
+
+
+
+void fl_tiled_image_color_average(TILED_IMAGE t, int c, float b) {
+ // virtual so disable dispatch
+ reinterpret_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::color_average(c, b);
+}
+
+void fl_tiled_image_desaturate(TILED_IMAGE t) {
+ // virtual so disable dispatch
+ reinterpret_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::desaturate();
+}
+
+
+
+
+void fl_tiled_image_draw(TILED_IMAGE t, int x, int y) {
+ reinterpret_cast<Fl_Tiled_Image*>(t)->draw(x, y);
+}
+
+void fl_tiled_image_draw2(TILED_IMAGE t, int x, int y, int w, int h, int cx, int cy) {
+ // virtual so disable dispatch
+ reinterpret_cast<Fl_Tiled_Image*>(t)->Fl_Tiled_Image::draw(x, y, w, h, cx, cy);
+}
+
+
diff --git a/src/c_fl_tiled_image.h b/src/c_fl_tiled_image.h
new file mode 100644
index 0000000..12b1c1e
--- /dev/null
+++ b/src/c_fl_tiled_image.h
@@ -0,0 +1,34 @@
+
+
+#ifndef FL_TILED_IMAGE_GUARD
+#define FL_TILED_IMAGE_GUARD
+
+
+
+
+typedef void* TILED_IMAGE;
+
+
+
+
+extern "C" TILED_IMAGE new_fl_tiled_image(void * i, int w, int h);
+extern "C" void free_fl_tiled_image(TILED_IMAGE t);
+extern "C" TILED_IMAGE fl_tiled_image_copy(TILED_IMAGE t, int w, int h);
+extern "C" TILED_IMAGE fl_tiled_image_copy2(TILED_IMAGE t);
+
+
+
+
+extern "C" void * fl_tiled_image_get_image(TILED_IMAGE t);
+
+
+extern "C" void fl_tiled_image_color_average(TILED_IMAGE t, int c, float b);
+extern "C" void fl_tiled_image_desaturate(TILED_IMAGE t);
+
+
+extern "C" void fl_tiled_image_draw(TILED_IMAGE t, int x, int y);
+extern "C" void fl_tiled_image_draw2(TILED_IMAGE t, int x, int y, int w, int h, int cx, int cy);
+
+
+#endif
+
diff --git a/src/fltk-images-tiled.adb b/src/fltk-images-tiled.adb
new file mode 100644
index 0000000..fd4b9ed
--- /dev/null
+++ b/src/fltk-images-tiled.adb
@@ -0,0 +1,233 @@
+
+
+with
+
+ Interfaces.C,
+ System;
+
+use type
+
+ System.Address;
+
+
+package body FLTK.Images.Tiled is
+
+
+ function new_fl_tiled_image
+ (T : in System.Address;
+ W, H : in Interfaces.C.int)
+ return System.Address;
+ pragma Import (C, new_fl_tiled_image, "new_fl_tiled_image");
+ pragma Inline (new_fl_tiled_image);
+
+ procedure free_fl_tiled_image
+ (T : in System.Address);
+ pragma Import (C, free_fl_tiled_image, "free_fl_tiled_image");
+ pragma Inline (free_fl_tiled_image);
+
+ function fl_tiled_image_copy
+ (T : in System.Address;
+ W, H : in Interfaces.C.int)
+ return System.Address;
+ pragma Import (C, fl_tiled_image_copy, "fl_tiled_image_copy");
+ pragma Inline (fl_tiled_image_copy);
+
+ function fl_tiled_image_copy2
+ (T : in System.Address)
+ return System.Address;
+ pragma Import (C, fl_tiled_image_copy2, "fl_tiled_image_copy2");
+ pragma Inline (fl_tiled_image_copy2);
+
+
+
+
+ function fl_tiled_image_get_image
+ (T : in System.Address)
+ return System.Address;
+ pragma Import (C, fl_tiled_image_get_image, "fl_tiled_image_get_image");
+ pragma Inline (fl_tiled_image_get_image);
+
+
+
+
+ procedure fl_tiled_image_color_average
+ (T : in System.Address;
+ C : in Interfaces.C.int;
+ B : in Interfaces.C.C_float);
+ pragma Import (C, fl_tiled_image_color_average, "fl_tiled_image_color_average");
+ pragma Inline (fl_tiled_image_color_average);
+
+ procedure fl_tiled_image_desaturate
+ (T : in System.Address);
+ pragma Import (C, fl_tiled_image_desaturate, "fl_tiled_image_desaturate");
+ pragma Inline (fl_tiled_image_desaturate);
+
+
+
+
+ procedure fl_tiled_image_draw
+ (T : in System.Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_tiled_image_draw, "fl_tiled_image_draw");
+ pragma Inline (fl_tiled_image_draw);
+
+ procedure fl_tiled_image_draw2
+ (T : in System.Address;
+ X, Y, W, H : in Interfaces.C.int;
+ CX, CY : in Interfaces.C.int);
+ pragma Import (C, fl_tiled_image_draw2, "fl_tiled_image_draw2");
+ pragma Inline (fl_tiled_image_draw2);
+
+
+
+
+ overriding procedure Finalize
+ (This : in out Tiled_Image) is
+ begin
+ if This.Void_Ptr /= System.Null_Address and then
+ This in Tiled_Image'Class
+ then
+ free_fl_tiled_image (This.Void_Ptr);
+ This.Void_Ptr := System.Null_Address;
+ end if;
+ Finalize (Image (This));
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package body Forge is
+
+ function Create
+ (From : in out Image'Class;
+ W, H : in Integer := 0)
+ return Tiled_Image is
+ begin
+ return This : Tiled_Image do
+ This.Void_Ptr := new_fl_tiled_image
+ (From.Void_Ptr,
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr);
+ This.Dummy.Needs_Dealloc := False;
+ end return;
+ end Create;
+
+ end Forge;
+
+
+ function Copy
+ (This : in Tiled_Image;
+ Width, Height : in Natural)
+ return Tiled_Image'Class is
+ begin
+ return Copied : Tiled_Image do
+ Copied.Void_Ptr := fl_tiled_image_copy
+ (This.Void_Ptr,
+ Interfaces.C.int (Width),
+ Interfaces.C.int (Height));
+ Copied.Dummy.Void_Ptr := fl_tiled_image_get_image (Copied.Void_Ptr);
+ Copied.Dummy.Needs_Dealloc := False;
+ end return;
+ end Copy;
+
+
+ function Copy
+ (This : in Tiled_Image)
+ return Tiled_Image'Class is
+ begin
+ return Copied : Tiled_Image do
+ Copied.Void_Ptr := fl_tiled_image_copy2 (This.Void_Ptr);
+ Copied.Dummy.Void_Ptr := fl_tiled_image_get_image (Copied.Void_Ptr);
+ Copied.Dummy.Needs_Dealloc := False;
+ end return;
+ end Copy;
+
+
+
+
+ ---------------------
+ -- Miscellaneous --
+ ---------------------
+
+ procedure Inactive
+ (This : in out Tiled_Image) is
+ begin
+ This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr);
+ This.Dummy.Needs_Dealloc := False;
+ Image (This).Inactive;
+ end Inactive;
+
+
+ function Tile
+ (This : in out Tiled_Image)
+ return Image_Reference is
+ begin
+ return (Data => This.Dummy'Unchecked_Access);
+ end Tile;
+
+
+
+
+ --------------
+ -- Colors --
+ --------------
+
+ procedure Color_Average
+ (This : in out Tiled_Image;
+ Hue : in Color;
+ Amount : in Blend) is
+ begin
+ This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr);
+ This.Dummy.Needs_Dealloc := False;
+ fl_tiled_image_color_average
+ (This.Void_Ptr,
+ Interfaces.C.int (Hue),
+ Interfaces.C.C_float (Amount));
+ end Color_Average;
+
+
+ procedure Desaturate
+ (This : in out Tiled_Image) is
+ begin
+ This.Dummy.Void_Ptr := fl_tiled_image_get_image (This.Void_Ptr);
+ This.Dummy.Needs_Dealloc := False;
+ fl_tiled_image_desaturate (This.Void_Ptr);
+ end Desaturate;
+
+
+
+
+ procedure Draw
+ (This : in Tiled_Image;
+ X, Y : in Integer) is
+ begin
+ fl_tiled_image_draw
+ (This.Void_Ptr,
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y));
+ end Draw;
+
+
+ procedure Draw
+ (This : in Tiled_Image;
+ X, Y, W, H : in Integer;
+ CX, CY : in Integer) is
+ begin
+ fl_tiled_image_draw2
+ (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;
+
+
+end FLTK.Images.Tiled;
+
diff --git a/src/fltk-images-tiled.ads b/src/fltk-images-tiled.ads
new file mode 100644
index 0000000..cf3ee13
--- /dev/null
+++ b/src/fltk-images-tiled.ads
@@ -0,0 +1,112 @@
+
+
+package FLTK.Images.Tiled is
+
+
+ -------------
+ -- Types --
+ -------------
+
+ type Tiled_Image is new Image with private;
+
+ type Tiled_Image_Reference (Data : not null access Tiled_Image'Class) is
+ limited null record with Implicit_Dereference => Data;
+
+
+
+
+ --------------------
+ -- Construction --
+ --------------------
+
+ package Forge is
+
+ function Create
+ (From : in out Image'Class;
+ W, H : in Integer := 0)
+ return Tiled_Image;
+
+ end Forge;
+
+ function Copy
+ (This : in Tiled_Image;
+ Width, Height : in Natural)
+ return Tiled_Image'Class;
+
+ function Copy
+ (This : in Tiled_Image)
+ return Tiled_Image'Class;
+
+
+
+
+ ---------------------
+ -- Miscellaneous --
+ ---------------------
+
+ procedure Inactive
+ (This : in out Tiled_Image);
+
+ function Tile
+ (This : in out Tiled_Image)
+ return Image_Reference;
+
+
+
+
+ --------------
+ -- Colors --
+ --------------
+
+ procedure Color_Average
+ (This : in out Tiled_Image;
+ Hue : in Color;
+ Amount : in Blend);
+
+ procedure Desaturate
+ (This : in out Tiled_Image);
+
+
+
+
+ ---------------
+ -- Drawing --
+ ---------------
+
+ procedure Draw
+ (This : in Tiled_Image;
+ X, Y : in Integer);
+
+ procedure Draw
+ (This : in Tiled_Image;
+ X, Y, W, H : in Integer;
+ CX, CY : in Integer);
+
+
+private
+
+
+ type Tiled_Image is new Image with record
+ Dummy : aliased Image;
+ end record;
+
+ overriding procedure Finalize
+ (This : in out Tiled_Image);
+
+
+ pragma Inline (Copy);
+
+
+ pragma Inline (Inactive);
+ pragma Inline (Tile);
+
+
+ pragma Inline (Color_Average);
+ pragma Inline (Desaturate);
+
+
+ pragma Inline (Draw);
+
+
+end FLTK.Images.Tiled;
+
diff --git a/src/fltk-images.adb b/src/fltk-images.adb
index b8dff24..f86071e 100644
--- a/src/fltk-images.adb
+++ b/src/fltk-images.adb
@@ -165,7 +165,9 @@ package body FLTK.Images is
if This.Void_Ptr /= System.Null_Address and then
This in Image'Class
then
- free_fl_image (This.Void_Ptr);
+ if This.Needs_Dealloc then
+ free_fl_image (This.Void_Ptr);
+ end if;
This.Void_Ptr := System.Null_Address;
end if;
end Finalize;