diff options
| -rw-r--r-- | body/fltk-widgets-valuators.adb | 7 | ||||
| -rw-r--r-- | test/arc.adb | 149 | ||||
| -rw-r--r-- | tests.gpr | 2 |
3 files changed, 156 insertions, 2 deletions
diff --git a/body/fltk-widgets-valuators.adb b/body/fltk-widgets-valuators.adb index 4b8db3f..0cf8d65 100644 --- a/body/fltk-widgets-valuators.adb +++ b/body/fltk-widgets-valuators.adb @@ -198,13 +198,16 @@ package body FLTK.Widgets.Valuators is pragma Assert (Userdata /= Null_Pointer); Ada_Obj := Valuator_Convert.To_Pointer (Storage.To_Address (Userdata)); declare + -- God this whole Format method is sketchy as hell. + -- ...what? This is the area to declare things and that needed declaring. String_Result : String := Ada_Obj.Format; begin if String_Result'Length <= FLTK.Buffer_Size then - Interfaces.C.Strings.Update (Buffer, 0, String_Result); + Interfaces.C.Strings.Update (Buffer, 0, Interfaces.C.To_C (String_Result), False); return String_Result'Length; else - Interfaces.C.Strings.Update (Buffer, 0, String_Result (1 .. Buffer_Size)); + Interfaces.C.Strings.Update + (Buffer, 0, Interfaces.C.To_C (String_Result (1 .. Buffer_Size)), False); return Interfaces.C.int (FLTK.Buffer_Size); end if; end; diff --git a/test/arc.adb b/test/arc.adb new file mode 100644 index 0000000..88d2214 --- /dev/null +++ b/test/arc.adb @@ -0,0 +1,149 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +-- Arc drawing test program functionality duplicated in Ada + + +with + + FLTK.Draw, + FLTK.Widgets.Groups.Windows.Double, + FLTK.Widgets.Valuators.Sliders.Value.Horizontal; + + +function Arc + return Integer +is + + + package FDR renames FLTK.Draw; + package WD renames FLTK.Widgets.Groups.Windows.Double; + package HV renames FLTK.Widgets.Valuators.Sliders.Value.Horizontal; + + + -- More convenient to have these all as floats instead of integers + Arg_Values : array (Positive range <>) of aliased Long_Float := + (140.0, 140.0, 50.0, 0.0, 360.0, 0.0); + + + type Drawing_Widget is new FLTK.Widgets.Widget with null record; + + procedure Draw + (This : in out Drawing_Widget) is + begin + FDR.Push_Clip (This.Get_X, This.Get_Y, This.Get_W, This.Get_H); + FDR.Set_Color (FLTK.Dark3_Color); + FDR.Rect_Fill (This.Get_X, This.Get_Y, This.Get_W, This.Get_H); + FDR.Push_Matrix; + if Arg_Values (6) > 0.001 then + FDR.Translate + (Long_Float (This.Get_X) + Long_Float (This.Get_W) / 2.0, + Long_Float (This.Get_Y) + Long_Float (This.Get_H) / 2.0); + FDR.Rotate (Arg_Values (6)); + FDR.Translate + (-1.0 * (Long_Float (This.Get_X) + Long_Float (This.Get_W) / 2.0), + -1.0 * (Long_Float (This.Get_Y) + Long_Float (This.Get_H) / 2.0)); + end if; + FDR.Set_Color (FLTK.White_Color); + FDR.Translate (Long_Float (This.Get_X), Long_Float (This.Get_Y)); + FDR.Begin_Complex_Polygon; + FDR.Arc (Arg_Values (1), Arg_Values (2), Arg_Values (3), Arg_Values (4), Arg_Values (5)); + FDR.Gap; + FDR.Arc (140.0, 140.0, 20.0, 0.0, -360.0); + FDR.End_Complex_Polygon; + FDR.Set_Color (FLTK.Red_Color); + FDR.Begin_Line; + FDR.Arc (Arg_Values (1), Arg_Values (2), Arg_Values (3), Arg_Values (4), Arg_Values (5)); + FDR.End_Line; + FDR.Pop_Matrix; + FDR.Pop_Clip; + end Draw; + + + The_Window : WD.Double_Window := WD.Forge.Create (300, 460, "Arc Testing"); + + The_Drawing : Drawing_Widget := + (FLTK.Widgets.Forge.Create (The_Window, 10, 10, 280, 280) + with null record); + + + type My_Slider is new HV.Horizontal_Value_Slider with record + Index : Integer range Arg_Values'Range; + end record; + + + -- Trying out some stack allocation for this one + + Slider_One : aliased My_Slider := + (HV.Forge.Create (The_Window, 50, 300, 240, 25, "X") + with Index => 1); + + Slider_Two : aliased My_Slider := + (HV.Forge.Create (The_Window, 50, 325, 240, 25, "Y") + with Index => 2); + + Slider_Three : aliased My_Slider := + (HV.Forge.Create (The_Window, 50, 350, 240, 25, "R") + with Index => 3); + + Slider_Four : aliased My_Slider := + (HV.Forge.Create (The_Window, 50, 375, 240, 25, "start") + with Index => 4); + + Slider_Five : aliased My_Slider := + (HV.Forge.Create (The_Window, 50, 400, 240, 25, "end") + with Index => 5); + + Slider_Six : aliased My_Slider := + (HV.Forge.Create (The_Window, 50, 425, 240, 25, "rotate") + with Index => 6); + + + type Slider_Access is access all My_Slider; + + Sliders : array (Positive range <>) of Slider_Access := + (Slider_One'Access, Slider_Two'Access, Slider_Three'Access, + Slider_Four'Access, Slider_Five'Access, Slider_Six'Access); + + + procedure Slider_Callback + (Item : in out FLTK.Widgets.Widget'Class) + is + Slide : My_Slider renames My_Slider (Item); + begin + Arg_Values (Slide.Index) := Slide.Get_Value; + The_Drawing.Redraw; + end Slider_Callback; + + +begin + + + for Place in Integer range 1 .. 6 loop + if Place <= 3 then + Sliders (Place).Set_Minimum (0.0); + Sliders (Place).Set_Maximum (300.0); + elsif Place = 6 then + Sliders (Place).Set_Minimum (0.0); + Sliders (Place).Set_Maximum (360.0); + else + Sliders (Place).Set_Minimum (-360.0); + Sliders (Place).Set_Maximum (360.0); + end if; + Sliders (Place).Set_Step_Bottom (1); + Sliders (Place).Set_Value (Arg_Values (Place)); + Sliders (Place).Set_Alignment (FLTK.Align_Left); + Sliders (Place).Set_Callback (Slider_Callback'Unrestricted_Access); + end loop; + + The_Window.Show_With_Args; + + return FLTK.Run; + + +end Arc; + + @@ -17,6 +17,7 @@ project Tests is for Main use ("adjuster.adb", "animated.adb", + "arc.adb", "compare.adb", "dirlist.adb", "page_formats.adb"); @@ -24,6 +25,7 @@ project Tests is package Builder is for Executable ("adjuster.adb") use "adjuster"; for Executable ("animated.adb") use "animated"; + for Executable ("arc.adb") use "arc"; for Executable ("compare.adb") use "compare"; for Executable ("dirlist.adb") use "dirlist"; for Executable ("page_formats.adb") use "page_formats"; |