diff options
| -rw-r--r-- | doc/fl_tiled_image.html | 148 | ||||
| -rw-r--r-- | doc/index.html | 3 | ||||
| -rw-r--r-- | progress.txt | 4 | ||||
| -rw-r--r-- | src/c_fl_tiled_image.cpp | 60 | ||||
| -rw-r--r-- | src/c_fl_tiled_image.h | 34 | ||||
| -rw-r--r-- | src/fltk-images-tiled.adb | 233 | ||||
| -rw-r--r-- | src/fltk-images-tiled.ads | 112 | ||||
| -rw-r--r-- | src/fltk-images.adb | 4 |
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> </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; |