From fb4183c9244ee31aa5cb8bc9745c9242b1fafeeb Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Fri, 11 Apr 2025 22:21:26 +1200 Subject: Moved Size_Type to FLTK and better incorporated it into Bitmaps and RGB_Images --- spec/fltk-draw.ads | 12 ++++++------ spec/fltk-images-bitmaps.ads | 17 +++++++++-------- spec/fltk-images-rgb.ads | 23 ++++++++++------------- spec/fltk.ads | 11 ++++++++--- 4 files changed, 33 insertions(+), 30 deletions(-) (limited to 'spec') diff --git a/spec/fltk-draw.ads b/spec/fltk-draw.ads index 8346112..a2c66f3 100644 --- a/spec/fltk-draw.ads +++ b/spec/fltk-draw.ads @@ -256,8 +256,8 @@ package FLTK.Draw is Flip_Horizontal : in Boolean := False; Flip_Vertical : in Boolean := False) with Pre => (if Line_Size = 0 - then Data'Length >= W * H * Depth - else Data'Length >= Line_Size * H); + then Data'Length >= Size_Type (W) * Size_Type (H) * Size_Type (Depth) + else Data'Length >= Size_Type (Line_Size) * Size_Type (H)); procedure Draw_Image (X, Y, W, H : in Integer; @@ -272,8 +272,8 @@ package FLTK.Draw is Flip_Horizontal : Boolean := False; Flip_Vertical : Boolean := False) with Pre => (if Line_Size = 0 - then Data'Length >= W * H * Depth - else Data'Length >= Line_Size * H); + then Data'Length >= Size_Type (W) * Size_Type (H) * Size_Type (Depth) + else Data'Length >= Size_Type (Line_Size) * Size_Type (H)); procedure Draw_Image_Mono (X, Y, W, H : in Integer; @@ -299,8 +299,8 @@ package FLTK.Draw is return Color_Component_Array with Post => (if Alpha = 0 - then Read_Image'Result'Length = W * H * 3 - else Read_Image'Result'Length = W * H * 4); + then Read_Image'Result'Length = Size_Type (W) * Size_Type (H) * 3 + else Read_Image'Result'Length = Size_Type (W) * Size_Type (H) * 4); diff --git a/spec/fltk-images-bitmaps.ads b/spec/fltk-images-bitmaps.ads index 73afc62..9577273 100644 --- a/spec/fltk-images-bitmaps.ads +++ b/spec/fltk-images-bitmaps.ads @@ -33,7 +33,8 @@ package FLTK.Images.Bitmaps is (Data : in Color_Component_Array; Width, Height : in Natural) return Bitmap - with Pre => Data'Length >= Bytes_Needed (Width) * Height; + with Pre => + Data'Length >= Size_Type (Bytes_Needed (Width)) * Size_Type (Height); end Forge; @@ -66,31 +67,31 @@ package FLTK.Images.Bitmaps is function Data_Size (This : in Bitmap) - return Natural; + return Size_Type; function Get_Datum (This : in Bitmap; - Place : in Positive) + Place : in Positive_Size) return Color_Component with Pre => Place <= This.Data_Size; procedure Set_Datum (This : in out Bitmap; - Place : in Positive; + Place : in Positive_Size; Value : in Color_Component) with Pre => Place <= This.Data_Size; function Slice (This : in Bitmap; - Low : in Positive; - High : in Natural) + Low : in Positive_Size; + High : in Size_Type) return Color_Component_Array with Pre => High <= This.Data_Size, - Post => Slice'Result'Length = Integer'Max (0, High - Low + 1); + Post => Slice'Result'Length = Size_Type'Max (0, High - Low + 1); procedure Overwrite (This : in out Bitmap; - Place : in Positive; + Place : in Positive_Size; Values : in Color_Component_Array) with Pre => Place + Values'Length - 1 <= This.Data_Size; diff --git a/spec/fltk-images-rgb.ads b/spec/fltk-images-rgb.ads index 242098a..d893cec 100644 --- a/spec/fltk-images-rgb.ads +++ b/spec/fltk-images-rgb.ads @@ -6,8 +6,7 @@ with - FLTK.Images.Pixmaps, - System.Storage_Elements; + FLTK.Images.Pixmaps; package FLTK.Images.RGB is @@ -20,8 +19,6 @@ package FLTK.Images.RGB is type RGB_Image_Array is array (Positive range <>) of RGB_Image; - type Size_Type is mod 2 ** System.Storage_Elements.Integer_Address'Size; - @@ -48,8 +45,8 @@ package FLTK.Images.RGB is 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) + then Data'Length >= Size_Type (Width) * Size_Type (Height) * Size_Type (Depth) + else Data'Length >= Size_Type (Line_Size) * Size_Type (Height)) and Data'Length <= Get_Max_Size; function Create @@ -101,31 +98,31 @@ package FLTK.Images.RGB is function Data_Size (This : in RGB_Image) - return Natural; + return Size_Type; function Get_Datum (This : in RGB_Image; - Place : in Positive) + Place : in Positive_Size) return Color_Component with Pre => Place <= This.Data_Size; procedure Set_Datum (This : in out RGB_Image; - Place : in Positive; + Place : in Positive_Size; Value : in Color_Component) with Pre => Place <= This.Data_Size; function Slice (This : in RGB_Image; - Low : in Positive; - High : in Natural) + Low : in Positive_Size; + High : in Size_Type) return Color_Component_Array with Pre => High <= This.Data_Size, - Post => Slice'Result'Length = Integer'Max (0, High - Low + 1); + Post => Slice'Result'Length = Size_Type'Max (0, High - Low + 1); procedure Overwrite (This : in out RGB_Image; - Place : in Positive; + Place : in Positive_Size; Values : in Color_Component_Array) with Pre => Place + Values'Length - 1 <= This.Data_Size; diff --git a/spec/fltk.ads b/spec/fltk.ads index f5add9b..964af79 100644 --- a/spec/fltk.ads +++ b/spec/fltk.ads @@ -6,7 +6,8 @@ with - Ada.Finalization; + Ada.Finalization, + System; private with @@ -34,18 +35,22 @@ package FLTK is -- Text buffers for marshalling purposes will be this size. Buffer_Size : constant Natural := 1024; + -- For image data arrays. + type Size_Type is mod 2 ** System.Word_Size; + subtype Positive_Size is Size_Type range 1 .. Size_Type'Last; + -- Color -- - -- Values scale from A/Black to X/White + -- Values scale from A/Black to X/White. type Greyscale is new Character range 'A' .. 'X'; type Color is mod 2**32; type Color_Component is mod 256; - type Color_Component_Array is array (Positive range <>) of aliased Color_Component; + type Color_Component_Array is array (Positive_Size range <>) of aliased Color_Component; subtype Blend is Float range 0.0 .. 1.0; -- cgit