summaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/arc.adb149
-rw-r--r--test/ask.adb144
-rw-r--r--test/bitmap.adb163
3 files changed, 456 insertions, 0 deletions
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;
+
+
diff --git a/test/ask.adb b/test/ask.adb
new file mode 100644
index 0000000..201d245
--- /dev/null
+++ b/test/ask.adb
@@ -0,0 +1,144 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+-- Standard dialog test program functionality reproduced in Ada
+
+
+with
+
+ Ada.Characters.Latin_1,
+ Ada.Command_Line,
+ FLTK.Asks,
+ FLTK.Static,
+ FLTK.Widgets.Boxes,
+ FLTK.Widgets.Buttons,
+ FLTK.Widgets.Buttons.Enter,
+ FLTK.Widgets.Inputs.Text,
+ FLTK.Widgets.Groups.Windows.Double;
+
+use type
+
+ FLTK.Asks.Choice_Result,
+ FLTK.Color;
+
+
+function Ask
+ return Integer
+is
+
+
+ package Latin renames Ada.Characters.Latin_1;
+ package ACom renames Ada.Command_Line;
+
+ package AK renames FLTK.Asks;
+ package Stc renames FLTK.Static;
+ package BX renames FLTK.Widgets.Boxes;
+ package BTN renames FLTK.Widgets.Buttons;
+ package ENT renames FLTK.Widgets.Buttons.Enter;
+ package INP renames FLTK.Widgets.Inputs.Text;
+ package WD renames FLTK.Widgets.Groups.Windows.Double;
+
+
+ procedure Update_Input_Text
+ (Item : in out FLTK.Widgets.Widget'Class;
+ Text : in String) is
+ begin
+ Item.Set_Label (Text);
+ Item.Redraw;
+ end Update_Input_Text;
+
+
+ procedure Rename_Me
+ (Item : in out FLTK.Widgets.Widget'Class)
+ is
+ Input : String := AK.Text_Input ("Input:", Item.Get_Label);
+ begin
+ Update_Input_Text (Item, Input);
+ end Rename_Me;
+
+
+ procedure Rename_Me_Pwd
+ (Item : in out FLTK.Widgets.Widget'Class)
+ is
+ Input : String := AK.Password ("Input PWD:", Item.Get_Label);
+ begin
+ Update_Input_Text (Item, Input);
+ end Rename_Me_Pwd;
+
+
+ procedure Window_Callback
+ (Item : in out FLTK.Widgets.Widget'Class)
+ is
+ Hotspot : Boolean := AK.Get_Message_Hotspot;
+ Reply : AK.Choice_Result;
+ begin
+ AK.Set_Message_Hotspot (False);
+ AK.Set_Message_Title ("Note: No hotspot set for this dialog");
+ Reply := AK.Choice ("Are you sure you want to quit?", "Cancel", "Quit", "Dunno");
+ AK.Set_Message_Hotspot (Hotspot);
+ if Reply = AK.Second then
+ ACom.Set_Exit_Status (ACom.Success);
+ WD.Double_Window (Item).Hide;
+ elsif Reply = AK.Third then
+ AK.Message_Box ("Well, maybe you should know before we quit.");
+ end if;
+ end Window_Callback;
+
+
+ Stop : Boolean := False;
+
+ procedure Timer_Callback is
+ Change : Long_Float := 5.0;
+ Message_Icon : BX.Box_Reference := AK.Get_Message_Icon;
+ My_Color : FLTK.Color;
+ begin
+ Stc.Repeat_Timeout (Change, Timer_Callback'Unrestricted_Access);
+
+ if Stop then
+ Message_Icon.Set_Background_Color (FLTK.White_Color);
+ return;
+ end if;
+
+ My_Color := Message_Icon.Get_Background_Color;
+ My_Color := (My_Color + 1) mod 32;
+ if My_Color = Message_Icon.Get_Label_Color then
+ My_Color := My_Color + 1;
+ end if;
+ Message_Icon.Set_Background_Color (My_Color);
+
+ Stop := AK.Choice
+ ("Timeout. Click the 'Close' button." & Latin.LF &
+ "Note: This message is blocked in FLTK 1.3" & Latin.LF &
+ "if another message window is open." & Latin.LF &
+ "This message should pop up every 5 seconds.",
+ "Close", "Stop these funny popups") = AK.Second;
+ end Timer_Callback;
+
+
+ The_Window : WD.Double_Window := WD.Forge.Create (200, 105, "Ask Test");
+
+ Button_One : ENT.Enter_Button := ENT.Forge.Create (The_Window, 20, 10, 160, 35, "Test text");
+ Button_Two : BTN.Button := BTN.Forge.Create (The_Window, 20, 50, 160, 35, "MyPassword");
+
+
+begin
+
+
+ Button_One.Set_Callback (Rename_Me'Unrestricted_Access);
+ Button_Two.Set_Callback (Rename_Me_Pwd'Unrestricted_Access);
+
+ The_Window.Set_Resizable (Button_One);
+ The_Window.Set_Callback (Window_Callback'Unrestricted_Access);
+ The_Window.Show_With_Args;
+
+ Stc.Add_Timeout (5.0, Timer_Callback'Unrestricted_Access);
+
+ return FLTK.Run;
+
+
+end Ask;
+
+
diff --git a/test/bitmap.adb b/test/bitmap.adb
new file mode 100644
index 0000000..af8ddfa
--- /dev/null
+++ b/test/bitmap.adb
@@ -0,0 +1,163 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+-- Bitmap label test program functionality reproduced in Ada
+
+
+with
+
+ FLTK.Images.Bitmaps,
+ FLTK.Widgets.Buttons,
+ FLTK.Widgets.Buttons.Toggle,
+ FLTK.Widgets.Groups.Windows.Double;
+
+use type
+
+ FLTK.Alignment,
+ FLTK.Widgets.Buttons.State;
+
+
+function Bitmap
+ return Integer
+is
+
+
+ package IT renames FLTK.Images.Bitmaps;
+ package BTN renames FLTK.Widgets.Buttons;
+ package TOG renames FLTK.Widgets.Buttons.Toggle;
+ package WD renames FLTK.Widgets.Groups.Windows.Double;
+
+
+ Sorceress_Width : constant Integer := 75;
+ Sorceress_Height : constant Integer := 75;
+
+
+ Sorceress_Bits : constant FLTK.Color_Component_Array :=
+ (16#fc#, 16#7e#, 16#40#, 16#20#, 16#90#, 16#00#, 16#07#, 16#80#, 16#23#, 16#00#, 16#00#, 16#c6#,
+ 16#c1#, 16#41#, 16#98#, 16#b8#, 16#01#, 16#07#, 16#66#, 16#00#, 16#15#, 16#9f#, 16#03#, 16#47#,
+ 16#8c#, 16#c6#, 16#dc#, 16#7b#, 16#cc#, 16#00#, 16#b0#, 16#71#, 16#0e#, 16#4d#, 16#06#, 16#66#,
+ 16#73#, 16#8e#, 16#8f#, 16#01#, 16#18#, 16#c4#, 16#39#, 16#4b#, 16#02#, 16#23#, 16#0c#, 16#04#,
+ 16#1e#, 16#03#, 16#0c#, 16#08#, 16#c7#, 16#ef#, 16#08#, 16#30#, 16#06#, 16#07#, 16#1c#, 16#02#,
+ 16#06#, 16#30#, 16#18#, 16#ae#, 16#c8#, 16#98#, 16#3f#, 16#78#, 16#20#, 16#06#, 16#02#, 16#20#,
+ 16#60#, 16#a0#, 16#c4#, 16#1d#, 16#c0#, 16#ff#, 16#41#, 16#04#, 16#fa#, 16#63#, 16#80#, 16#a1#,
+ 16#a4#, 16#3d#, 16#00#, 16#84#, 16#bf#, 16#04#, 16#0f#, 16#06#, 16#fc#, 16#a1#, 16#34#, 16#6b#,
+ 16#01#, 16#1c#, 16#c9#, 16#05#, 16#06#, 16#c7#, 16#06#, 16#be#, 16#11#, 16#1e#, 16#43#, 16#30#,
+ 16#91#, 16#05#, 16#c3#, 16#61#, 16#02#, 16#30#, 16#1b#, 16#30#, 16#cc#, 16#20#, 16#11#, 16#00#,
+ 16#c1#, 16#3c#, 16#03#, 16#20#, 16#0a#, 16#00#, 16#e8#, 16#60#, 16#21#, 16#00#, 16#61#, 16#1b#,
+ 16#c1#, 16#63#, 16#08#, 16#f0#, 16#c6#, 16#c7#, 16#21#, 16#03#, 16#f8#, 16#08#, 16#e1#, 16#cf#,
+ 16#0a#, 16#fc#, 16#4d#, 16#99#, 16#43#, 16#07#, 16#3c#, 16#0c#, 16#f1#, 16#9f#, 16#0b#, 16#fc#,
+ 16#5b#, 16#81#, 16#47#, 16#02#, 16#16#, 16#04#, 16#31#, 16#1c#, 16#0b#, 16#1f#, 16#17#, 16#89#,
+ 16#4d#, 16#06#, 16#1a#, 16#04#, 16#31#, 16#38#, 16#02#, 16#07#, 16#56#, 16#89#, 16#49#, 16#04#,
+ 16#0b#, 16#04#, 16#b1#, 16#72#, 16#82#, 16#a1#, 16#54#, 16#9a#, 16#49#, 16#04#, 16#1d#, 16#66#,
+ 16#50#, 16#e7#, 16#c2#, 16#f0#, 16#54#, 16#9a#, 16#58#, 16#04#, 16#0d#, 16#62#, 16#c1#, 16#1f#,
+ 16#44#, 16#fc#, 16#51#, 16#90#, 16#90#, 16#04#, 16#86#, 16#63#, 16#e0#, 16#74#, 16#04#, 16#ef#,
+ 16#31#, 16#1a#, 16#91#, 16#00#, 16#02#, 16#e2#, 16#c1#, 16#fd#, 16#84#, 16#f9#, 16#30#, 16#0a#,
+ 16#91#, 16#00#, 16#82#, 16#a9#, 16#c0#, 16#b9#, 16#84#, 16#f9#, 16#31#, 16#16#, 16#81#, 16#00#,
+ 16#42#, 16#a9#, 16#db#, 16#7f#, 16#0c#, 16#ff#, 16#1c#, 16#16#, 16#11#, 16#00#, 16#02#, 16#28#,
+ 16#0b#, 16#07#, 16#08#, 16#60#, 16#1c#, 16#02#, 16#91#, 16#00#, 16#46#, 16#29#, 16#0e#, 16#00#,
+ 16#00#, 16#00#, 16#10#, 16#16#, 16#11#, 16#02#, 16#06#, 16#29#, 16#04#, 16#00#, 16#00#, 16#00#,
+ 16#10#, 16#16#, 16#91#, 16#06#, 16#a6#, 16#2a#, 16#04#, 16#00#, 16#00#, 16#00#, 16#18#, 16#24#,
+ 16#91#, 16#04#, 16#86#, 16#2a#, 16#04#, 16#00#, 16#00#, 16#00#, 16#18#, 16#27#, 16#93#, 16#04#,
+ 16#96#, 16#4a#, 16#04#, 16#00#, 16#00#, 16#00#, 16#04#, 16#02#, 16#91#, 16#04#, 16#86#, 16#4a#,
+ 16#0c#, 16#00#, 16#00#, 16#00#, 16#1e#, 16#23#, 16#93#, 16#04#, 16#56#, 16#88#, 16#08#, 16#00#,
+ 16#00#, 16#00#, 16#90#, 16#21#, 16#93#, 16#04#, 16#52#, 16#0a#, 16#09#, 16#80#, 16#01#, 16#00#,
+ 16#d0#, 16#21#, 16#95#, 16#04#, 16#57#, 16#0a#, 16#0f#, 16#80#, 16#27#, 16#00#, 16#d8#, 16#20#,
+ 16#9d#, 16#04#, 16#5d#, 16#08#, 16#1c#, 16#80#, 16#67#, 16#00#, 16#e4#, 16#01#, 16#85#, 16#04#,
+ 16#79#, 16#8a#, 16#3f#, 16#00#, 16#00#, 16#00#, 16#f4#, 16#11#, 16#85#, 16#06#, 16#39#, 16#08#,
+ 16#7d#, 16#00#, 16#00#, 16#18#, 16#b7#, 16#10#, 16#81#, 16#03#, 16#29#, 16#12#, 16#cb#, 16#00#,
+ 16#7e#, 16#30#, 16#28#, 16#00#, 16#85#, 16#03#, 16#29#, 16#10#, 16#be#, 16#81#, 16#ff#, 16#27#,
+ 16#0c#, 16#10#, 16#85#, 16#03#, 16#29#, 16#32#, 16#fa#, 16#c1#, 16#ff#, 16#27#, 16#94#, 16#11#,
+ 16#85#, 16#03#, 16#28#, 16#20#, 16#6c#, 16#e1#, 16#ff#, 16#07#, 16#0c#, 16#01#, 16#85#, 16#01#,
+ 16#28#, 16#62#, 16#5c#, 16#e3#, 16#8f#, 16#03#, 16#4e#, 16#91#, 16#80#, 16#05#, 16#39#, 16#40#,
+ 16#f4#, 16#c2#, 16#ff#, 16#00#, 16#9f#, 16#91#, 16#84#, 16#05#, 16#31#, 16#c6#, 16#e8#, 16#07#,
+ 16#7f#, 16#80#, 16#cd#, 16#00#, 16#c4#, 16#04#, 16#31#, 16#06#, 16#c9#, 16#0e#, 16#00#, 16#c0#,
+ 16#48#, 16#88#, 16#e0#, 16#04#, 16#79#, 16#04#, 16#db#, 16#12#, 16#00#, 16#30#, 16#0c#, 16#c8#,
+ 16#e4#, 16#04#, 16#6d#, 16#06#, 16#b6#, 16#23#, 16#00#, 16#18#, 16#1c#, 16#c0#, 16#84#, 16#04#,
+ 16#25#, 16#0c#, 16#ff#, 16#c2#, 16#00#, 16#4e#, 16#06#, 16#b0#, 16#80#, 16#04#, 16#3f#, 16#8a#,
+ 16#b3#, 16#83#, 16#ff#, 16#c3#, 16#03#, 16#91#, 16#84#, 16#04#, 16#2e#, 16#d8#, 16#0f#, 16#3f#,
+ 16#00#, 16#00#, 16#5f#, 16#83#, 16#84#, 16#04#, 16#2a#, 16#70#, 16#fd#, 16#7f#, 16#00#, 16#00#,
+ 16#c8#, 16#c0#, 16#84#, 16#04#, 16#4b#, 16#e2#, 16#2f#, 16#01#, 16#00#, 16#08#, 16#58#, 16#60#,
+ 16#80#, 16#04#, 16#5b#, 16#82#, 16#ff#, 16#01#, 16#00#, 16#08#, 16#d0#, 16#a0#, 16#84#, 16#04#,
+ 16#72#, 16#80#, 16#e5#, 16#00#, 16#00#, 16#08#, 16#d2#, 16#20#, 16#44#, 16#04#, 16#ca#, 16#02#,
+ 16#ff#, 16#00#, 16#00#, 16#08#, 16#de#, 16#a0#, 16#44#, 16#04#, 16#82#, 16#02#, 16#6d#, 16#00#,
+ 16#00#, 16#08#, 16#f6#, 16#b0#, 16#40#, 16#02#, 16#82#, 16#07#, 16#3f#, 16#00#, 16#00#, 16#08#,
+ 16#44#, 16#58#, 16#44#, 16#02#, 16#93#, 16#3f#, 16#1f#, 16#00#, 16#00#, 16#30#, 16#88#, 16#4f#,
+ 16#44#, 16#03#, 16#83#, 16#23#, 16#3e#, 16#00#, 16#00#, 16#00#, 16#18#, 16#60#, 16#e0#, 16#07#,
+ 16#e3#, 16#0f#, 16#fe#, 16#00#, 16#00#, 16#00#, 16#70#, 16#70#, 16#e4#, 16#07#, 16#c7#, 16#1b#,
+ 16#fe#, 16#01#, 16#00#, 16#00#, 16#e0#, 16#3c#, 16#e4#, 16#07#, 16#c7#, 16#e3#, 16#fe#, 16#1f#,
+ 16#00#, 16#00#, 16#ff#, 16#1f#, 16#fc#, 16#07#, 16#c7#, 16#03#, 16#f8#, 16#33#, 16#00#, 16#c0#,
+ 16#f0#, 16#07#, 16#ff#, 16#07#, 16#87#, 16#02#, 16#fc#, 16#43#, 16#00#, 16#60#, 16#f0#, 16#ff#,
+ 16#ff#, 16#07#, 16#8f#, 16#06#, 16#be#, 16#87#, 16#00#, 16#30#, 16#f8#, 16#ff#, 16#ff#, 16#07#,
+ 16#8f#, 16#14#, 16#9c#, 16#8f#, 16#00#, 16#00#, 16#fc#, 16#ff#, 16#ff#, 16#07#, 16#9f#, 16#8d#,
+ 16#8a#, 16#0f#, 16#00#, 16#00#, 16#fe#, 16#ff#, 16#ff#, 16#07#, 16#bf#, 16#0b#, 16#80#, 16#1f#,
+ 16#00#, 16#00#, 16#ff#, 16#ff#, 16#ff#, 16#07#, 16#7f#, 16#3a#, 16#80#, 16#3f#, 16#00#, 16#80#,
+ 16#ff#, 16#ff#, 16#ff#, 16#07#, 16#ff#, 16#20#, 16#c0#, 16#3f#, 16#00#, 16#80#, 16#ff#, 16#ff#,
+ 16#ff#, 16#07#, 16#ff#, 16#01#, 16#e0#, 16#7f#, 16#00#, 16#c0#, 16#ff#, 16#ff#, 16#ff#, 16#07#,
+ 16#ff#, 16#0f#, 16#f8#, 16#ff#, 16#40#, 16#e0#, 16#ff#, 16#ff#, 16#ff#, 16#07#, 16#ff#, 16#ff#,
+ 16#ff#, 16#ff#, 16#40#, 16#f0#, 16#ff#, 16#ff#, 16#ff#, 16#07#, 16#ff#, 16#ff#, 16#ff#, 16#ff#,
+ 16#41#, 16#f0#, 16#ff#, 16#ff#, 16#ff#, 16#07#);
+
+
+ The_Window : WD.Double_Window := WD.Forge.Create (400, 400, "Sorcery of Bitmap Labels");
+
+ The_Button : BTN.Button := BTN.Forge.Create (The_Window, 140, 160, 120, 120, "Bitmap");
+
+ Left_Btn : TOG.Toggle_Button := TOG.Forge.Create (The_Window, 25, 50, 50, 25, "left");
+ Right_Btn : TOG.Toggle_Button := TOG.Forge.Create (The_Window, 75, 50, 50, 25, "right");
+ Top_Btn : TOG.Toggle_Button := TOG.Forge.Create (The_Window, 125, 50, 50, 25, "top");
+ Bottom_Btn : TOG.Toggle_Button := TOG.Forge.Create (The_Window, 175, 50, 50, 25, "bottom");
+ Inside_Btn : TOG.Toggle_Button := TOG.Forge.Create (The_Window, 225, 50, 50, 25, "inside");
+ Over_Btn : TOG.Toggle_Button := TOG.Forge.Create (The_Window, 25, 75, 100, 25, "text over");
+ Inact_Btn : TOG.Toggle_Button := TOG.Forge.Create (The_Window, 125, 75, 100, 25, "inactive");
+
+ Sorceress : IT.Bitmap := IT.Forge.Create (Sorceress_Bits, Sorceress_Width, Sorceress_Height);
+
+
+ procedure Button_Callback
+ (Item : in out FLTK.Widgets.Widget'Class)
+ is
+ New_Align : FLTK.Alignment;
+ begin
+ if Left_Btn.Is_On then New_Align := New_Align + FLTK.Align_Left; end if;
+ if Right_Btn.Is_On then New_Align := New_Align + FLTK.Align_Right; end if;
+ if Top_Btn.Is_On then New_Align := New_Align + FLTK.Align_Top; end if;
+ if Bottom_Btn.Is_On then New_Align := New_Align + FLTK.Align_Bottom; end if;
+ if Inside_Btn.Is_On then New_Align := New_Align + FLTK.Align_Inside; end if;
+ if Over_Btn.Is_On then New_Align := New_Align + FLTK.Align_Text_Over_Image; end if;
+ The_Button.Set_Alignment (New_Align);
+
+ if Inact_Btn.Is_On then
+ The_Button.Deactivate;
+ else
+ The_Button.Activate;
+ end if;
+
+ The_Window.Redraw;
+ end Button_Callback;
+
+
+begin
+
+
+ The_Button.Set_Image (Sorceress);
+
+ Left_Btn.Set_Callback (Button_Callback'Unrestricted_Access);
+ Right_Btn.Set_Callback (Button_Callback'Unrestricted_Access);
+ Top_Btn.Set_Callback (Button_Callback'Unrestricted_Access);
+ Bottom_Btn.Set_Callback (Button_Callback'Unrestricted_Access);
+ Inside_Btn.Set_Callback (Button_Callback'Unrestricted_Access);
+ Over_Btn.Set_Callback (Button_Callback'Unrestricted_Access);
+ Inact_Btn.Set_Callback (Button_Callback'Unrestricted_Access);
+
+ The_Window.Set_Resizable (The_Window);
+ The_Window.Show_With_Args;
+
+ return FLTK.Run;
+
+
+end Bitmap;
+
+
generated by cgit (git 2.30.0) at 2025-01-22 14:50:45 +0000