summaryrefslogtreecommitdiff
path: root/spec
diff options
context:
space:
mode:
Diffstat (limited to 'spec')
-rw-r--r--spec/fltk-images-bitmaps-xbm.ads9
-rw-r--r--spec/fltk-images-bitmaps.ads87
-rw-r--r--spec/fltk-images-pixmaps-gif.ads9
-rw-r--r--spec/fltk-images-pixmaps-xpm.ads9
-rw-r--r--spec/fltk-images-pixmaps.ads75
-rw-r--r--spec/fltk-images-rgb-bmp.ads9
-rw-r--r--spec/fltk-images-rgb-jpeg.ads9
-rw-r--r--spec/fltk-images-rgb-png.ads9
-rw-r--r--spec/fltk-images-rgb-pnm.ads9
-rw-r--r--spec/fltk-images-rgb.ads95
-rw-r--r--spec/fltk-images-tiled.ads29
-rw-r--r--spec/fltk-images.ads124
12 files changed, 242 insertions, 231 deletions
diff --git a/spec/fltk-images-bitmaps-xbm.ads b/spec/fltk-images-bitmaps-xbm.ads
index 0887666..5805332 100644
--- a/spec/fltk-images-bitmaps-xbm.ads
+++ b/spec/fltk-images-bitmaps-xbm.ads
@@ -7,10 +7,6 @@
package FLTK.Images.Bitmaps.XBM is
- -------------
- -- Types --
- -------------
-
type XBM_Image is new Bitmap with private;
type XBM_Image_Reference (Data : not null access XBM_Image'Class) is limited null record
@@ -19,10 +15,6 @@ package FLTK.Images.Bitmaps.XBM is
- --------------------
- -- Construction --
- --------------------
-
package Forge is
function Create
@@ -43,3 +35,4 @@ private
end FLTK.Images.Bitmaps.XBM;
+
diff --git a/spec/fltk-images-bitmaps.ads b/spec/fltk-images-bitmaps.ads
index d8730a2..d60334f 100644
--- a/spec/fltk-images-bitmaps.ads
+++ b/spec/fltk-images-bitmaps.ads
@@ -7,10 +7,6 @@
package FLTK.Images.Bitmaps is
- -------------
- -- Types --
- -------------
-
type Bitmap is new Image with private;
type Bitmap_Reference (Data : not null access Bitmap'Class) is limited null record
@@ -19,22 +15,31 @@ package FLTK.Images.Bitmaps is
- --------------------
- -- Construction --
- --------------------
+ function To_Next_Byte
+ (Bits : in Natural)
+ return Natural;
+
+
+
package Forge is
- -- Please note that I'm pretty sure (?) input data here should be some
- -- declared item that lives at least as long as the resulting Bitmap
+ -- Please note that input data should be some declared item
+ -- that lives at least as long as the resulting Bitmap.
function Create
(Data : in Color_Component_Array;
Width, Height : in Natural)
- return Bitmap;
+ return Bitmap
+ with Pre => Data'Length = To_Next_Byte (Width) * Height;
end Forge;
+
+
+
+ -- Copying --
+
function Copy
(This : in Bitmap;
Width, Height : in Natural)
@@ -47,9 +52,7 @@ package FLTK.Images.Bitmaps is
- ----------------
-- Activity --
- ----------------
procedure Uncache
(This : in out Bitmap);
@@ -57,18 +60,56 @@ package FLTK.Images.Bitmaps is
- ---------------
+ -- Pixel Data --
+
+ function Data_Size
+ (This : in Bitmap)
+ return Natural;
+
+ function Get_Datum
+ (This : in Bitmap;
+ Place : in Positive)
+ return Color_Component
+ with Pre => Place <= This.Data_Size;
+
+ procedure Set_Datum
+ (This : in out Bitmap;
+ Place : in Positive;
+ Value : in Color_Component)
+ with Pre => Place <= This.Data_Size;
+
+ function Slice
+ (This : in Bitmap;
+ Low : in Positive;
+ High : in Natural)
+ return Color_Component_Array
+ with Pre => High <= This.Data_Size,
+ Post => Slice'Result'Length = Integer'Max (0, High - Low + 1);
+
+ procedure Overwrite
+ (This : in out Bitmap;
+ Place : in Positive;
+ Values : in Color_Component_Array)
+ with Pre => Place + Values'Length - 1 <= This.Data_Size;
+
+ function All_Data
+ (This : in Bitmap)
+ return Color_Component_Array
+ with Post => All_Data'Result'Length = This.Data_Size;
+
+
+
+
-- Drawing --
- ---------------
procedure Draw
(This : in Bitmap;
X, Y : in Integer);
procedure Draw
- (This : in Bitmap;
- X, Y, W, H : in Integer;
- CX, CY : in Integer := 0);
+ (This : in Bitmap;
+ X, Y, W, H : in Integer;
+ Clip_X, Clip_Y : in Integer := 0);
private
@@ -80,10 +121,22 @@ private
(This : in out Bitmap);
+ pragma Inline (To_Next_Byte);
+
pragma Inline (Copy);
+
pragma Inline (Uncache);
+
+ pragma Inline (Data_Size);
+ pragma Inline (Get_Datum);
+ pragma Inline (Set_Datum);
+ pragma Inline (Slice);
+ pragma Inline (Overwrite);
+ pragma Inline (All_Data);
+
pragma Inline (Draw);
end FLTK.Images.Bitmaps;
+
diff --git a/spec/fltk-images-pixmaps-gif.ads b/spec/fltk-images-pixmaps-gif.ads
index 7084a13..5720138 100644
--- a/spec/fltk-images-pixmaps-gif.ads
+++ b/spec/fltk-images-pixmaps-gif.ads
@@ -7,10 +7,6 @@
package FLTK.Images.Pixmaps.GIF is
- -------------
- -- Types --
- -------------
-
type GIF_Image is new Pixmap with private;
type GIF_Image_Reference (Data : not null access GIF_Image'Class) is
@@ -19,10 +15,6 @@ package FLTK.Images.Pixmaps.GIF is
- --------------------
- -- Construction --
- --------------------
-
package Forge is
function Create
@@ -43,3 +35,4 @@ private
end FLTK.Images.Pixmaps.GIF;
+
diff --git a/spec/fltk-images-pixmaps-xpm.ads b/spec/fltk-images-pixmaps-xpm.ads
index d5bae5a..c703264 100644
--- a/spec/fltk-images-pixmaps-xpm.ads
+++ b/spec/fltk-images-pixmaps-xpm.ads
@@ -7,10 +7,6 @@
package FLTK.Images.Pixmaps.XPM is
- -------------
- -- Types --
- -------------
-
type XPM_Image is new Pixmap with private;
type XPM_Image_Reference (Data : not null access XPM_Image'Class) is
@@ -19,10 +15,6 @@ package FLTK.Images.Pixmaps.XPM is
- --------------------
- -- Construction --
- --------------------
-
package Forge is
function Create
@@ -43,3 +35,4 @@ private
end FLTK.Images.Pixmaps.XPM;
+
diff --git a/spec/fltk-images-pixmaps.ads b/spec/fltk-images-pixmaps.ads
index 14e3f94..64d8330 100644
--- a/spec/fltk-images-pixmaps.ads
+++ b/spec/fltk-images-pixmaps.ads
@@ -4,12 +4,17 @@
-- Released into the public domain
-package FLTK.Images.Pixmaps is
+with
+
+ Ada.Strings.Unbounded;
+
+private with
+ Interfaces.C.Strings;
+
+
+package FLTK.Images.Pixmaps is
- -------------
- -- Types --
- -------------
type Pixmap is new Image with private;
@@ -17,11 +22,48 @@ package FLTK.Images.Pixmaps is
with Implicit_Dereference => Data;
+ type Header is record
+ Width, Height, Colors, Per_Pixel : Positive;
+ end record;
+
+ type Color_Kind is (Colorful, Monochrome, Greyscale, Symbolic);
+
+ type Color_Definition is record
+ Name : Ada.Strings.Unbounded.Unbounded_String;
+ Kind : Color_Kind;
+ Value : Ada.Strings.Unbounded.Unbounded_String;
+ end record;
+
+ type Color_Definition_Array is array (Positive range <>) of Color_Definition;
+
+ type Pixmap_Data is array (Positive range <>, Positive range <>) of Character;
+
- --------------------
- -- Construction --
- --------------------
+
+ package Forge is
+
+ -- Unlike Bitmaps or RGB_Images, you do NOT have to keep this data around.
+ -- A copy will be allocated and deallocated internally.
+
+ function Create
+ (Values : in Header;
+ Colors : in Color_Definition_Array;
+ Pixels : in Pixmap_Data)
+ return Pixmap
+ with Pre =>
+ Colors'Length = Values.Colors and
+ Pixels'Length (1) = Values.Height and
+ (for all Definition of Colors =>
+ Ada.Strings.Unbounded.Length (Definition.Name) = Values.Per_Pixel) and
+ Pixels'Length (2) = Values.Width * Values.Per_Pixel;
+
+ end Forge;
+
+
+
+
+ -- Copying --
function Copy
(This : in Pixmap;
@@ -35,9 +77,7 @@ package FLTK.Images.Pixmaps is
- --------------
-- Colors --
- --------------
procedure Color_Average
(This : in out Pixmap;
@@ -50,9 +90,7 @@ package FLTK.Images.Pixmaps is
- ----------------
-- Activity --
- ----------------
procedure Uncache
(This : in out Pixmap);
@@ -60,24 +98,24 @@ package FLTK.Images.Pixmaps is
- ---------------
-- Drawing --
- ---------------
procedure Draw
(This : in Pixmap;
X, Y : in Integer);
procedure Draw
- (This : in Pixmap;
- X, Y, W, H : in Integer;
- CX, CY : in Integer := 0);
+ (This : in Pixmap;
+ X, Y, W, H : in Integer;
+ Clip_X, Clip_Y : in Integer := 0);
private
- type Pixmap is new Image with null record;
+ type Pixmap is new Image with record
+ Loose_Ptr : access Interfaces.C.Strings.chars_ptr_array;
+ end record;
overriding procedure Finalize
(This : in out Pixmap);
@@ -86,13 +124,12 @@ private
pragma Inline (Color_Average);
pragma Inline (Desaturate);
-
pragma Inline (Uncache);
-
pragma Inline (Copy);
pragma Inline (Draw);
end FLTK.Images.Pixmaps;
+
diff --git a/spec/fltk-images-rgb-bmp.ads b/spec/fltk-images-rgb-bmp.ads
index 4eb9e1b..f2bf103 100644
--- a/spec/fltk-images-rgb-bmp.ads
+++ b/spec/fltk-images-rgb-bmp.ads
@@ -7,10 +7,6 @@
package FLTK.Images.RGB.BMP is
- -------------
- -- Types --
- -------------
-
type BMP_Image is new RGB_Image with private;
type BMP_Image_Reference (Data : not null access BMP_Image'Class) is limited null record
@@ -19,10 +15,6 @@ package FLTK.Images.RGB.BMP is
- --------------------
- -- Construction --
- --------------------
-
package Forge is
function Create
@@ -43,3 +35,4 @@ private
end FLTK.Images.RGB.BMP;
+
diff --git a/spec/fltk-images-rgb-jpeg.ads b/spec/fltk-images-rgb-jpeg.ads
index 0349b01..8bb21ba 100644
--- a/spec/fltk-images-rgb-jpeg.ads
+++ b/spec/fltk-images-rgb-jpeg.ads
@@ -7,10 +7,6 @@
package FLTK.Images.RGB.JPEG is
- -------------
- -- Types --
- -------------
-
type JPEG_Image is new RGB_Image with private;
type JPEG_Image_Reference (Data : not null access JPEG_Image'Class) is
@@ -19,10 +15,6 @@ package FLTK.Images.RGB.JPEG is
- --------------------
- -- Construction --
- --------------------
-
package Forge is
function Create
@@ -48,3 +40,4 @@ private
end FLTK.Images.RGB.JPEG;
+
diff --git a/spec/fltk-images-rgb-png.ads b/spec/fltk-images-rgb-png.ads
index 23890b3..dcfbd4f 100644
--- a/spec/fltk-images-rgb-png.ads
+++ b/spec/fltk-images-rgb-png.ads
@@ -7,10 +7,6 @@
package FLTK.Images.RGB.PNG is
- -------------
- -- Types --
- -------------
-
type PNG_Image is new RGB_Image with private;
type PNG_Image_Reference (Data : not null access PNG_Image'Class) is limited null record
@@ -19,10 +15,6 @@ package FLTK.Images.RGB.PNG is
- --------------------
- -- Construction --
- --------------------
-
package Forge is
function Create
@@ -48,3 +40,4 @@ private
end FLTK.Images.RGB.PNG;
+
diff --git a/spec/fltk-images-rgb-pnm.ads b/spec/fltk-images-rgb-pnm.ads
index d72706b..847b149 100644
--- a/spec/fltk-images-rgb-pnm.ads
+++ b/spec/fltk-images-rgb-pnm.ads
@@ -7,10 +7,6 @@
package FLTK.Images.RGB.PNM is
- -------------
- -- Types --
- -------------
-
type PNM_Image is new RGB_Image with private;
type PNM_Image_Reference (Data : not null access PNM_Image'Class) is limited null record
@@ -19,10 +15,6 @@ package FLTK.Images.RGB.PNM is
- --------------------
- -- Construction --
- --------------------
-
package Forge is
function Create
@@ -43,3 +35,4 @@ private
end FLTK.Images.RGB.PNM;
+
diff --git a/spec/fltk-images-rgb.ads b/spec/fltk-images-rgb.ads
index 5768b3c..a935872 100644
--- a/spec/fltk-images-rgb.ads
+++ b/spec/fltk-images-rgb.ads
@@ -12,10 +12,6 @@ with
package FLTK.Images.RGB is
- -------------
- -- Types --
- -------------
-
type RGB_Image is new Image with private;
type RGB_Image_Reference (Data : not null access RGB_Image'Class) is limited null record
@@ -24,18 +20,30 @@ package FLTK.Images.RGB is
- --------------------
- -- Construction --
- --------------------
+ function Get_Max_Size
+ return Natural;
+
+ procedure Set_Max_Size
+ (Value : in Natural);
+
+
+
package Forge is
+ -- Please note that input data should be some declared item
+ -- that lives at least as long as the resulting RGB_Image.
+
function Create
(Data : in Color_Component_Array;
Width, Height : in Natural;
Depth : in Natural := 3;
- Line_Data : in Natural := 0)
- return RGB_Image;
+ Line_Size : in Natural := 0)
+ return RGB_Image
+ with Pre => (if Line_Size = 0
+ then Data'Length = Width * Height * Depth
+ else Data'Length = Line_Size * Height)
+ and Data'Length <= Get_Max_Size;
function Create
(Data : in FLTK.Images.Pixmaps.Pixmap'Class;
@@ -44,11 +52,10 @@ package FLTK.Images.RGB is
end Forge;
- function Get_Max_Size
- return Natural;
- procedure Set_Max_Size
- (Value : in Natural);
+
+
+ -- Copying --
function Copy
(This : in RGB_Image;
@@ -62,9 +69,7 @@ package FLTK.Images.RGB is
- --------------
-- Colors --
- --------------
procedure Color_Average
(This : in out RGB_Image;
@@ -77,9 +82,7 @@ package FLTK.Images.RGB is
- ----------------
-- Activity --
- ----------------
procedure Uncache
(This : in out RGB_Image);
@@ -87,18 +90,56 @@ package FLTK.Images.RGB is
- ---------------
+ -- Pixel Data --
+
+ function Data_Size
+ (This : in RGB_Image)
+ return Natural;
+
+ function Get_Datum
+ (This : in RGB_Image;
+ Place : in Positive)
+ return Color_Component
+ with Pre => Place <= This.Data_Size;
+
+ procedure Set_Datum
+ (This : in out RGB_Image;
+ Place : in Positive;
+ Value : in Color_Component)
+ with Pre => Place <= This.Data_Size;
+
+ function Slice
+ (This : in RGB_Image;
+ Low : in Positive;
+ High : in Natural)
+ return Color_Component_Array
+ with Pre => High <= This.Data_Size,
+ Post => Slice'Result'Length = Integer'Max (0, High - Low + 1);
+
+ procedure Overwrite
+ (This : in out RGB_Image;
+ Place : in Positive;
+ Values : in Color_Component_Array)
+ with Pre => Place + Values'Length - 1 <= This.Data_Size;
+
+ function All_Data
+ (This : in RGB_Image)
+ return Color_Component_Array
+ with Post => All_Data'Result'Length = This.Data_Size;
+
+
+
+
-- Drawing --
- ---------------
procedure Draw
(This : in RGB_Image;
X, Y : in Integer);
procedure Draw
- (This : in RGB_Image;
- X, Y, W, H : in Integer;
- CX, CY : in Integer := 0);
+ (This : in RGB_Image;
+ X, Y, W, H : in Integer;
+ Clip_X, Clip_Y : in Integer := 0);
private
@@ -112,18 +153,24 @@ private
pragma Inline (Get_Max_Size);
pragma Inline (Set_Max_Size);
- pragma Inline (Copy);
+ pragma Inline (Copy);
pragma Inline (Color_Average);
pragma Inline (Desaturate);
-
pragma Inline (Uncache);
+ pragma Inline (Data_Size);
+ pragma Inline (Get_Datum);
+ pragma Inline (Set_Datum);
+ pragma Inline (Slice);
+ pragma Inline (Overwrite);
+ pragma Inline (All_Data);
pragma Inline (Draw);
end FLTK.Images.RGB;
+
diff --git a/spec/fltk-images-tiled.ads b/spec/fltk-images-tiled.ads
index a7e775e..a7470fc 100644
--- a/spec/fltk-images-tiled.ads
+++ b/spec/fltk-images-tiled.ads
@@ -7,10 +7,6 @@
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
@@ -19,10 +15,6 @@ package FLTK.Images.Tiled is
- --------------------
- -- Construction --
- --------------------
-
package Forge is
function Create
@@ -32,6 +24,11 @@ package FLTK.Images.Tiled is
end Forge;
+
+
+
+ -- Copying --
+
function Copy
(This : in Tiled_Image;
Width, Height : in Natural)
@@ -44,9 +41,7 @@ package FLTK.Images.Tiled is
- ---------------------
-- Miscellaneous --
- ---------------------
procedure Inactive
(This : in out Tiled_Image);
@@ -58,9 +53,7 @@ package FLTK.Images.Tiled is
- --------------
-- Colors --
- --------------
procedure Color_Average
(This : in out Tiled_Image;
@@ -73,18 +66,16 @@ package FLTK.Images.Tiled is
- ---------------
-- 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);
+ (This : in Tiled_Image;
+ X, Y, W, H : in Integer;
+ Clip_X, Clip_Y : in Integer);
private
@@ -100,17 +91,15 @@ private
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/spec/fltk-images.ads b/spec/fltk-images.ads
index 9a02f23..165c203 100644
--- a/spec/fltk-images.ads
+++ b/spec/fltk-images.ads
@@ -7,10 +7,6 @@
package FLTK.Images is
- -------------
- -- Types --
- -------------
-
type Image is new Wrapper with private;
type Image_Reference (Data : not null access Image'Class) is limited null record
@@ -20,23 +16,27 @@ package FLTK.Images is
type Blend is new Float range 0.0 .. 1.0;
- No_Image_Error, File_Access_Error, Format_Error : exception;
+ No_Image_Error, File_Access_Error, Format_Error : exception;
- --------------------
- -- Construction --
- --------------------
package Forge is
+ -- This creates an empty image with no data, so not that useful.
+
function Create
(Width, Height, Depth : in Natural)
return Image;
end Forge;
+
+
+
+ -- Copying --
+
function Get_Copy_Algorithm
return Scaling_Kind;
@@ -55,9 +55,7 @@ package FLTK.Images is
- --------------
-- Colors --
- --------------
procedure Color_Average
(This : in out Image;
@@ -70,9 +68,7 @@ package FLTK.Images is
- ----------------
-- Activity --
- ----------------
procedure Inactive
(This : in out Image);
@@ -87,9 +83,7 @@ package FLTK.Images is
- ------------------
-- Dimensions --
- ------------------
function Get_W
(This : in Image)
@@ -103,86 +97,23 @@ package FLTK.Images is
(This : in Image)
return Natural;
- function Get_Line_Data
+ function Get_Line_Size
(This : in Image)
return Natural;
- function Get_Data_Count
- (This : in Image)
- return Natural;
-
- function Get_Data_Size
- (This : in Image)
- return Natural;
-
-
-
-
- ------------------
- -- Pixel Data --
- ------------------
-
- function Get_Datum
- (This : in Image;
- Data : in Positive;
- Position : in Positive)
- return Color_Component
- with Pre =>
- Data <= Get_Data_Count (This) and
- Position <= Get_Data_Size (This);
-
- procedure Set_Datum
- (This : in out Image;
- Data : in Positive;
- Position : in Positive;
- Value : in Color_Component)
- with Pre =>
- Data <= Get_Data_Count (This) and
- Position <= Get_Data_Size (This);
-
- function Get_Data
- (This : in Image;
- Data : in Positive;
- Position : in Positive;
- Count : in Natural)
- return Color_Component_Array
- with Pre =>
- Data <= Get_Data_Count (This) and
- Position <= Get_Data_Size (This) and
- Count <= Get_Data_Size (This) - Position + 1;
-
- function All_Data
- (This : in Image;
- Data : in Positive)
- return Color_Component_Array
- with Pre =>
- Data <= Get_Data_Count (This);
-
- procedure Update_Data
- (This : in out Image;
- Data : in Positive;
- Position : in Positive;
- Values : in Color_Component_Array)
- with Pre =>
- Data <= Get_Data_Count (This) and
- Position <= Get_Data_Size (This) and
- Values'Length <= Get_Data_Size (This) - Position + 1;
-
- ---------------
-- Drawing --
- ---------------
procedure Draw
(This : in Image;
X, Y : in Integer);
procedure Draw
- (This : in Image;
- X, Y, W, H : in Integer;
- CX, CY : in Integer := 0);
+ (This : in Image;
+ X, Y, W, H : in Integer;
+ Clip_X, Clip_Y : in Integer := 0);
procedure Draw_Empty
(This : in Image;
@@ -198,40 +129,43 @@ private
(This : in out Image);
+ procedure Raise_Fail_Errors
+ (This : in Image'Class);
+
+
+ function fl_image_data
+ (I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_image_data, "fl_image_data");
+ pragma Inline (fl_image_data);
+
+ function fl_image_count
+ (I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_image_count, "fl_image_count");
+ pragma Inline (fl_image_count);
pragma Inline (Get_Copy_Algorithm);
pragma Inline (Set_Copy_Algorithm);
pragma Inline (Copy);
-
pragma Inline (Color_Average);
pragma Inline (Desaturate);
-
pragma Inline (Inactive);
pragma Inline (Is_Empty);
pragma Inline (Uncache);
-
pragma Inline (Get_W);
pragma Inline (Get_H);
pragma Inline (Get_D);
- pragma Inline (Get_Line_Data);
- pragma Inline (Get_Data_Count);
-
+ pragma Inline (Get_Line_Size);
pragma Inline (Draw);
pragma Inline (Draw_Empty);
-
-
- function fl_image_fail
- (I : in Storage.Integer_Address)
- return Interfaces.C.int;
- pragma Import (C, fl_image_fail, "fl_image_fail");
-
-
end FLTK.Images;
+
generated by cgit (git 2.30.0) at 2025-01-31 04:51:29 +0000