diff options
Diffstat (limited to 'body/fltk-draw.adb')
| -rw-r--r-- | body/fltk-draw.adb | 65 |
1 files changed, 37 insertions, 28 deletions
diff --git a/body/fltk-draw.adb b/body/fltk-draw.adb index e7119ed..38ccb80 100644 --- a/body/fltk-draw.adb +++ b/body/fltk-draw.adb @@ -14,8 +14,7 @@ with use type - Interfaces.C.int, - Interfaces.C.size_t; + Interfaces.C.int; package body FLTK.Draw is @@ -642,7 +641,7 @@ package body FLTK.Draw is function Can_Do_Alpha_Blending return Boolean is - Result : Interfaces.C.int := fl_draw_can_do_alpha_blending; + Result : constant Interfaces.C.int := fl_draw_can_do_alpha_blending; begin if Result = 1 then return True; @@ -662,7 +661,7 @@ package body FLTK.Draw is return String is begin return Interfaces.C.Strings.Value - (fl_draw_shortcut_label (Interfaces.C.unsigned (To_C (Keys)))); + (fl_draw_shortcut_label (To_C (Keys))); end Shortcut_Label; @@ -716,7 +715,7 @@ package body FLTK.Draw is return Boolean is CX, CY, CW, CH : Interfaces.C.int; - Result : Interfaces.C.int := fl_draw_clip_box + Result : constant Interfaces.C.int := fl_draw_clip_box (Interfaces.C.int (X), Interfaces.C.int (Y), Interfaces.C.int (W), @@ -1007,12 +1006,12 @@ package body FLTK.Draw is (X, Y, W, H : in Integer; Data : in Color_Component_Array; Depth : in Positive := 3; - Line_Data : in Natural := 0; + Line_Size : in Natural := 0; Flip_Horizontal : in Boolean := False; Flip_Vertical : in Boolean := False) is Real_Depth : Integer := Depth; - Real_Line_Data : Integer := Line_Data; + Real_Line_Data : Integer := Line_Size; begin if Flip_Horizontal then Real_Depth := Real_Depth * (-1); @@ -1025,7 +1024,9 @@ package body FLTK.Draw is end if; end if; fl_draw_draw_image - (Storage.To_Integer (Data (Data'First)'Address), + ((if Data'Length > 0 + then Storage.To_Integer (Data (Data'First)'Address) + else Null_Pointer), Interfaces.C.int (X), Interfaces.C.int (Y), Interfaces.C.int (W), @@ -1038,18 +1039,17 @@ package body FLTK.Draw is Image_Func_Ptr : Image_Draw_Function; procedure Draw_Image_Hook - (User : in Storage.Integer_Address; + (Ignore : in Storage.Integer_Address; X, Y, W : in Interfaces.C.int; Buf_Ptr : in Storage.Integer_Address); - pragma Convention (C, Draw_Image_Hook); procedure Draw_Image_Hook - (User : in Storage.Integer_Address; + (Ignore : in Storage.Integer_Address; X, Y, W : in Interfaces.C.int; Buf_Ptr : in Storage.Integer_Address) is - Data_Buffer : Color_Component_Array (1 .. Integer (W)); + Data_Buffer : Color_Component_Array (1 .. Size_Type (W)); for Data_Buffer'Address use Storage.To_Address (Buf_Ptr); pragma Import (Ada, Data_Buffer); begin @@ -1077,12 +1077,12 @@ package body FLTK.Draw is (X, Y, W, H : in Integer; Data : in Color_Component_Array; Depth : in Positive := 1; - Line_Data : in Natural := 0; + Line_Size : in Natural := 0; Flip_Horizontal : Boolean := False; Flip_Vertical : Boolean := False) is Real_Depth : Integer := Depth; - Real_Line_Data : Integer := Line_Data; + Real_Line_Data : Integer := Line_Size; begin if Flip_Horizontal then Real_Depth := Real_Depth * (-1); @@ -1095,7 +1095,9 @@ package body FLTK.Draw is end if; end if; fl_draw_draw_image_mono - (Storage.To_Integer (Data (Data'First)'Address), + ((if Data'Length > 0 + then Storage.To_Integer (Data (Data'First)'Address) + else Null_Pointer), Interfaces.C.int (X), Interfaces.C.int (Y), Interfaces.C.int (W), @@ -1108,18 +1110,17 @@ package body FLTK.Draw is Mono_Image_Func_Ptr : Image_Draw_Function; procedure Draw_Image_Mono_Hook - (User : in Storage.Integer_Address; + (Ignore : in Storage.Integer_Address; X, Y, W : in Interfaces.C.int; Buf_Ptr : in Storage.Integer_Address); - pragma Convention (C, Draw_Image_Mono_Hook); procedure Draw_Image_Mono_Hook - (User : in Storage.Integer_Address; + (Ignore : in Storage.Integer_Address; X, Y, W : in Interfaces.C.int; Buf_Ptr : in Storage.Integer_Address) is - Data_Buffer : Color_Component_Array (1 .. Integer (W)); + Data_Buffer : Color_Component_Array (1 .. Size_Type (W)); for Data_Buffer'Address use Storage.To_Address (Buf_Ptr); pragma Import (Ada, Data_Buffer); begin @@ -1148,15 +1149,15 @@ package body FLTK.Draw is Colors : in FLTK.Images.Pixmaps.Color_Definition_Array; Pixels : in FLTK.Images.Pixmaps.Pixmap_Data; X, Y : in Integer; - Hue : in Color := Grey0_Color) + Tone : in Color := Grey0_Color) is C_Data : Pixmap_Marshal.chars_ptr_array_access := Pixmap_Marshal.Marshal_Data (Values, Colors, Pixels); - Result : Interfaces.C.int := fl_draw_draw_pixmap + Result : constant Interfaces.C.int := fl_draw_draw_pixmap (Storage.To_Integer (C_Data (C_Data'First)'Address), Interfaces.C.int (X), Interfaces.C.int (Y), - Interfaces.C.unsigned (Hue)); + Interfaces.C.unsigned (Tone)); begin pragma Assert (Result /= 0); Pixmap_Marshal.Free_Recursive (C_Data); @@ -1172,18 +1173,26 @@ package body FLTK.Draw is Alpha : in Integer := 0) return Color_Component_Array is - My_Len : Integer := (if Alpha = 0 then W * H * 3 else W * H * 4); + My_Len : constant Size_Type := + (if Alpha = 0 + then Size_Type (W) * Size_Type (H) * 3 + else Size_Type (W) * Size_Type (H) * 4); Result : Color_Component_Array (1 .. My_Len); Buffer : Storage.Integer_Address; begin Buffer := fl_draw_read_image - (Storage.To_Integer (Result (Result'First)'Address), + ((if Result'Length > 0 + then Storage.To_Integer (Result (Result'First)'Address) + else Null_Pointer), Interfaces.C.int (X), Interfaces.C.int (Y), Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.int (Alpha)); - pragma Assert (Buffer = Storage.To_Integer (Result (Result'First)'Address)); + pragma Assert + ((if Result'Length > 0 + then Buffer = Storage.To_Integer (Result (Result'First)'Address) + else Buffer = Null_Pointer)); return Result; exception when Chk.Assertion_Error => raise Internal_FLTK_Error with @@ -1201,7 +1210,7 @@ package body FLTK.Draw is Callback : in Symbol_Draw_Function; Scalable : in Boolean) is - Ret_Val : Interfaces.C.int := fl_draw_add_symbol + Ret_Val : constant Interfaces.C.int := fl_draw_add_symbol (Interfaces.C.To_C (Text), Storage.To_Integer (Callback.all'Address), Boolean'Pos (Scalable)); @@ -1374,7 +1383,7 @@ package body FLTK.Draw is Name : in String; Hue : in Color) is - Ret_Val : Interfaces.C.int := fl_draw_draw_symbol + Ret_Val : constant Interfaces.C.int := fl_draw_draw_symbol (Interfaces.C.To_C (Name), Interfaces.C.int (X), Interfaces.C.int (Y), @@ -1479,7 +1488,7 @@ package body FLTK.Draw is Buffer : Interfaces.C.Strings.chars_ptr; Length : Interfaces.C.int; Temp : Interfaces.C.char_array := Interfaces.C.To_C (Text); - Result : Char_Pointers.Pointer := fl_draw_expand_text + Result : constant Char_Pointers.Pointer := fl_draw_expand_text (Temp, Buffer, 0, Interfaces.C.double (Max_Width), Length, |