------------------------------------------ -- agar_ada_demo.adb: Agar-GUI Ada demo -- ------------------------------------------ -- Public domain -- ------------------- with Agar.Init; with Agar.Error; with Agar.Data_Source; with Agar.Event; with Agar.Event_Loop; with Agar.Timer; with Agar.Object; with Agar.Init_GUI; with Agar.Surface; use Agar.Surface; with Agar.Text; with Agar.Widget; with Agar.Box; use Agar.Box; with Agar.Button; use Agar.Button; with Agar.Checkbox; use Agar.Checkbox; with Interfaces; use Interfaces; with Interfaces.C; with System; with Ada.Characters.Latin_1; with Ada.Real_Time; use Ada.Real_Time; with Ada.Text_IO; with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions; procedure agar_ada_demo is package AGO renames Agar.Object; package AGT renames Agar.Text; package AGW renames Agar.Widget; package C renames Interfaces.C; package T_IO renames Ada.Text_IO; package RT renames Ada.Real_Time; package LAT1 renames Ada.Characters.Latin_1; Epoch : constant RT.Time := RT.Clock; Major, Minor, Patch : Natural; begin -- -- Initialize the Agar-Core library. -- if not Agar.Init.Init_Core ("agar_ada_demo") then raise program_error with Agar.Error.Get_Error; end if; -- -- Initialize the Agar-GUI library and auto-select the driver backend. -- if not Agar.Init_GUI.Init_Graphics ("") then raise program_error with Agar.Error.Get_Error; end if; -- -- Print Agar version and memory model. -- declare begin Agar.Init.Get_Version(Major, Minor, Patch); T_IO.Put_Line(" _ _ _ ___ _ ___ _"); T_IO.Put_Line(" / _ \ / _ \ / _ \ | _ \ / _ \ | _ \ / _ \"); T_IO.Put_Line(" | |_| | | (_| | | |_| | | |_) | - | |_| | | |_) | | |_| |"); T_IO.Put_Line(" |_| |_| \__, | |_| |_| |_| |_| |_| |_| |___ / |_| |_|"); T_IO.Put_Line(" |___/ "); T_IO.Put_Line (Integer'Image(Major) & "." & Integer'Image(Minor) & "." & Integer'Image(Patch)); #if AG_MODEL = AG_MEDIUM T_IO.Put_Line("Memory model: MEDIUM"); #elsif AG_MODEL = AG_LARGE T_IO.Put_Line("Memory model: LARGE"); #end if; T_IO.Put_Line("Agar was initialized in" & Duration'Image(RT.To_Duration(RT.Clock - Epoch)) & "s"); end; -- -- Check that the ada object sizes match the definitions in agar.def -- (which is generated by a configure test which invokes the C API). -- declare procedure Check_Sizeof (Name : String; Size : Natural; D_Size : Natural) is Size_Bytes : constant Natural := Size / System.Storage_Unit; begin if (Size_Bytes /= D_Size) then raise Program_Error with "Size of " & Name & " (" & Natural'Image(Size_Bytes) & ") " & "differs from C API (" & Natural'Image(D_Size) & "). Need to recompile?"; else T_IO.Put_Line("Size of " & Name & " =" & Natural'Image(Size_Bytes) & " OK"); end if; end; begin -- Core -- Check_Sizeof("AG_Object", Agar.Object.Object'Size, $SIZEOF_AG_OBJECT); Check_Sizeof("AG_ObjectClass", Agar.Object.Class'Size, $SIZEOF_AG_OBJECTCLASS); Check_Sizeof("AG_DataSource", Agar.Data_Source.Data_Source'Size, $SIZEOF_AG_DATASOURCE); Check_Sizeof("AG_Event", Agar.Event.Event'Size, $SIZEOF_AG_EVENT); Check_Sizeof("AG_TimerPvt", Agar.Timer.Timer_Private'Size, $SIZEOF_AG_TIMERPVT); Check_Sizeof("AG_Timer", Agar.Timer.Timer'Size, $SIZEOF_AG_TIMER); -- GUI -- Check_Sizeof("AG_Color", Agar.Surface.AG_Color'Size, $SIZEOF_AG_COLOR); Check_Sizeof("AG_FontSpec", Agar.Text.Font_Spec'Size, $SIZEOF_AG_FONTSPEC); Check_Sizeof("AG_Font", Agar.Text.Font'Size, $SIZEOF_AG_FONT); Check_Sizeof("AG_Glyph", Agar.Text.Glyph'Size, $SIZEOF_AG_GLYPH); Check_Sizeof("AG_TextState", Agar.Text.Text_State_Rec'Size, $SIZEOF_AG_TEXTSTATE); Check_Sizeof("AG_TextMetrics", Agar.Text.Text_Metrics'Size, $SIZEOF_AG_TEXTMETRICS); Check_Sizeof("AG_Rect", Agar.Surface.AG_Rect'Size, $SIZEOF_AG_RECT); Check_Sizeof("AG_PixelFormat", Agar.Surface.Pixel_Format'Size, $SIZEOF_AG_PIXELFORMAT); Check_Sizeof("AG_Surface", Agar.Surface.Surface'Size, $SIZEOF_AG_SURFACE); end; -- -- Create a surface of pixels. -- declare W : constant Natural := 640; H : constant Natural := 480; Surf : constant Surface_Access := New_Surface(W,H); Blue : aliased AG_Color := Color_8(0,0,200,255); Border_W : constant Natural := 20; begin if Surf = null then raise Program_Error with Agar.Error.Get_Error; end if; -- -- Fill the background with a given color. -- Here are different ways of specifying colors: -- Fill_Rect (Surface => Surf, Color => Color_8(200,0,0)); -- 8-bit RGB components Fill_Rect (Surface => Surf, Color => Color_16(51400,0,0)); -- 16-bit RGB components Fill_Rect (Surface => Surf, Color => Color_HSV(0.9, 1.0, 1.0, 1.0)); -- Hue, Saturation & Value Fill_Rect (Surface => Surf, Color => Blue); -- An AG_Color argument -- Fill_Rect -- (Surface => Surf, -- Color => Blue'Unchecked_Access); -- An AG_Color access -- -- Use Put_Pixel to create a gradient. -- T_IO.Put_Line("Creating gradient"); for Y in Border_W .. H-Border_W loop if Y rem 4 = 0 then Blue.B := Blue.B - Component_Offset_8(1); end if; Blue.G := 0; for X in Border_W .. W-Border_W loop if X rem 8 = 0 then Blue.G := Blue.G + Component_Offset_8(1); end if; Put_Pixel (Surface => Surf, X => X, Y => Y, Pixel => Map_Pixel(Surf, Blue), Clipping => false); end loop; end loop; -- -- Generate a 2-bit indexed surface and initialize its 4-color palette. -- declare Bitmap : Surface_Access; begin T_IO.Put_Line("Generating a 2-bpp (4-color) indexed surface"); Bitmap := New_Surface (Mode => INDEXED, Bits_per_Pixel => 2, W => 128, H => 128); -- R G B -- Set_Color(Bitmap, 0, Color_8(0, 0, 0)); Set_Color(Bitmap, 1, Color_8(0, 100,0)); Set_Color(Bitmap, 2, Color_8(150,0, 0)); Set_Color(Bitmap, 3, Color_8(200,200,0)); for Y in 0 .. Bitmap.H loop for X in 0 .. Bitmap.W loop if Natural(X) rem 16 = 0 then Put_Pixel (Surface => Bitmap, X => Integer(X), Y => Integer(Y), Pixel => 1); else if Natural(Y) rem 8 = 0 then Put_Pixel (Surface => Bitmap, X => Integer(X), Y => Integer(Y), Pixel => 1); elsif Sqrt(Float(X)*Float(X) + Float(Y)*Float(Y)) < 50.0 then Put_Pixel (Surface => Bitmap, X => Integer(X), Y => Integer(Y), Pixel => 2); elsif Sqrt(Float(X)*Float(X) + Float(Y)*Float(Y)) > 150.0 then Put_Pixel (Surface => Bitmap, X => Integer(X), Y => Integer(Y), Pixel => 3); else Put_Pixel (Surface => Bitmap, X => Integer(X), Y => Integer(Y), Pixel => 0); end if; end if; end loop; end loop; -- -- Export our 2bpp bitmap to a PNG file. -- T_IO.Put_Line("Writing 2bpp bitmap to output-index.png"); if not Export_PNG(Bitmap, "output-index.png") then T_IO.Put_Line ("output-index.png: " & Agar.Error.Get_Error); end if; -- -- Blit our 2bpp bitmap to Surf. -- T_IO.Put_Line("Blitting 2bpp bitmap, converting"); Blit_Surface (Source => Bitmap, Target => Surf, Dst_X => 32, Dst_Y => 32); -- Blit again with a different palette. Set_Color(Bitmap, 0, Color_8(255,255,255)); Set_Color(Bitmap, 1, Color_8(100,100,180)); Set_Color(Bitmap, 2, Color_8(120,0,0)); Set_Color(Bitmap, 3, Color_8(0,0,150)); Blit_Surface (Source => Bitmap, Target => Surf, Dst_X => 200, Dst_Y => 32); Free_Surface (Bitmap); end; -- -- Test the font engine by rendering text to a surface. -- T_IO.Put_Line("Testing Agar's font engine"); declare Hello_Label : Surface_Access; Text_W, Text_H : Natural; Line_Count : Natural; begin -- Push rendering attributes onto the stack. AGT.Push_Text_State; -- Set the text color. AGT.Text_Set_Color_8(16#73fa00ff#); -- Render some text. Hello_Label := AGT.Text_Render("Hello, world!"); T_IO.Put_Line("Rendered `Hello' is:" & C.unsigned'Image(Hello_Label.W) & "x" & C.unsigned'Image(Hello_Label.H) & "x" & C.int'Image(Hello_Label.Format.Bits_per_Pixel) & "bpp"); Blit_Surface (Source => Hello_Label, Target => Surf, Dst_X => 0, Dst_Y => 0); Free_Surface(Hello_Label); -- Change some attributes and render text again. AGT.Text_Set_BG_Color_8(16#00ee00ff#); AGT.Text_Set_Color_8(16#000000ff#); AGT.Text_Set_Font (Family => "monoalgue", Size => AGT.Font_Points(18), Bold => True); Hello_Label := AGT.Text_Render("Hello, world!"); Blit_Surface (Source => Hello_Label, Target => Surf, Dst_X => 100, Dst_Y => 0); Free_Surface(Hello_Label); -- Set to 150% of the current font size and dark green BG. AGT.Text_Set_Font (Percent => 150); AGT.Text_Set_Color_8(255,150,150); AGT.Text_Set_BG_Color_8(16#005500ff#); Hello_Label := AGT.Text_Render ("Agar v" & Integer'Image(Major) & "." & Integer'Image(Minor) & "." & Integer'Image(Patch)); Blit_Surface (Source => Hello_Label, Target => Surf, Dst_X => 360, Dst_Y => 420); Free_Surface(Hello_Label); -- Calculate how large a surface needs to be to fit rendered text. AGT.Size_Text (Text => "Agar version " & Integer'Image(Major) & "." & Integer'Image(Minor) & "." & Integer'Image(Patch), W => Text_W, H => Text_H); T_IO.Put_Line("Font engine says `Hello' should take" & Natural'Image(Text_W) & " x" & Natural'Image(Text_H) & " pixels"); AGT.Size_Text (Text => "Hello, one" & LAT1.CR & LAT1.LF & "two" & LAT1.CR & LAT1.LF & "and three", W => Text_W, H => Text_H, Line_Count => Line_Count); T_IO.Put_Line("Font engine says three lines should take" & Natural'Image(Text_W) & " x" & Natural'Image(Text_H) & " pixels and" & Natural'Image(Line_Count) & " lines"); -- -- Calculate offsets needed to justify and align text in a given area. -- declare X,Y : Integer; begin AGT.Text_Align (W_Area => 320, H_Area => 240, W_Text => Text_W, H_Text => Text_H, X => X, Y => Y); T_IO.Put_Line("To center it in 320x240, offsets would be X:" & Natural'Image(X) & ", Y:" & Natural'Image(Y)); end; -- Pop rendering attributes off the stack. AGT.Pop_Text_State; end; -- -- Set a clipping rectangle. -- Set_Clipping_Rect (Surface => Surf, X => 55, Y => 220, W => 640-(55*2), H => 200); -- -- Show the extent of the clipping rectangle. -- T_IO.Put_Line("Testing clipping rectangles"); declare White : constant AG_Pixel := Map_Pixel(Surf, Color_8(255,255,255)); Clip_X : constant Integer := Integer(Surf.Clip_Rect.X); Clip_Y : constant Integer := Integer(Surf.Clip_Rect.Y); Clip_W : constant Integer := Integer(Surf.Clip_Rect.W); Clip_H : constant Integer := Integer(Surf.Clip_Rect.H); procedure Put_Crosshairs (Surface : Surface_Access; X,Y : Natural; Pixel : AG_Pixel) is begin for Z in 1 .. 3 loop Put_Pixel (Surface, X+Z,Y, Pixel, Clipping => false); Put_Pixel (Surface, X-Z,Y, Pixel, Clipping => false); Put_Pixel (Surface, X,Y+Z, Pixel, Clipping => false); Put_Pixel (Surface, X,Y-Z, Pixel, Clipping => false); end loop; end; begin Put_Crosshairs (Surf, Clip_X, Clip_Y, White); Put_Crosshairs (Surf, Clip_X+Clip_W, Clip_Y, White); Put_Crosshairs (Surf, Clip_X+Clip_W, Clip_Y+Clip_H, White); Put_Crosshairs (Surf, Clip_X, Clip_Y+Clip_H, White); end; T_IO.Put_Line ("Surf W:" & C.unsigned'Image(Surf.W) & " H:" & C.unsigned'Image(Surf.H) & " Pitch:" & C.unsigned'Image(Surf.Pitch) & " Clip_X:" & C.int'Image(Surf.Clip_Rect.X) & " Clip_Y:" & C.int'Image(Surf.Clip_Rect.Y) & " Clip_W:" & C.int'Image(Surf.Clip_Rect.W) & " Clip_H:" & C.int'Image(Surf.Clip_Rect.H) & " L_Padding:" & C.unsigned'Image(Surf.L_Padding) & " R_Padding:" & C.unsigned'Image(Surf.R_Padding)); -- -- Load a surface from a PNG file and blit it onto Surf. Transparency is -- expressed by colorkey, or by an alpha component of 0 (in packed RGBA). -- T_IO.Put_Line("Testing transparency"); declare use C; Denis : constant Surface_Access := New_Surface("champden.png"); Degs : Float := 0.0; Alpha : C.unsigned := 0; begin if Denis /= null then T_IO.Put_Line ("Denis W:" & C.unsigned'Image(Denis.W) & " H:" & C.unsigned'Image(Denis.H) & " Pitch:" & C.unsigned'Image(Denis.Pitch) & " Clip_X:" & C.int'Image(Denis.Clip_Rect.X) & " Clip_Y:" & C.int'Image(Denis.Clip_Rect.Y) & " Clip_W:" & C.int'Image(Denis.Clip_Rect.W) & " Clip_H:" & C.int'Image(Denis.Clip_Rect.H) & " L_Padding:" & C.unsigned'Image(Denis.L_Padding) & " R_Padding:" & C.unsigned'Image(Denis.R_Padding)); for Y in 1 .. 50 loop Degs := Degs + 30.0; Denis.Alpha := Alpha; #if AG_MODEL = AG_LARGE Alpha := Alpha + 3084; #else Alpha := Alpha + 12; #end if; -- Render to target coordinates under Surf. for Z in 1 .. 3 loop Blit_Surface (Source => Denis, Target => Surf, Dst_X => Y*25, Dst_Y => H/2 + Z*40 - Natural(Denis.H)/2 - Integer(50.0 * Sin(Degs,360.0))); end loop; end loop; else T_IO.Put_Line (Agar.Error.Get_Error); end if; end; T_IO.Put_Line("Testing export to PNG"); if not Export_PNG(Surf, "output.png") then raise program_error with Agar.Error.Get_Error; end if; T_IO.Put_Line ("Surface saved to output.png"); Free_Surface(Surf); end; -- -- Create an Agar window. -- T_IO.Put_Line("Creating an Agar window"); declare My_Window : AGW.Window_Access; begin My_Window := AGW.New_Window (Main => True, Name => "My_Window", Caption => "Ada Hello!", W => 320, H => 240, Min_W => 64, Min_H => 64); if (Agar.Object.Save (Object => AGW.Window_to_Object(My_Window), File => "window.out")) then T_IO.Put_Line ("Window state saved to window.out"); else T_IO.Put_Line ("Window state save: " & Agar.Error.Get_Error); end if; T_IO.Put_Line ("Window created. Caption is " & AGW.Get_Window_Caption(My_Window)); -- Set the titlebar text -- AGW.Set_Window_Caption(My_Window, "Ada Hello!!"); -- Create some widgets -- declare My_V_Box : Box_Access := New_Box (Parent => AGW.Window_To_Widget(My_Window), Orientation => VERTICAL_BOX, Expand => True, Shading => True); My_H_Box : Box_Access := New_Box (Parent => Box_To_Widget(My_V_Box), Orientation => HORIZONTAL_BOX, H_Fill => True); My_Button_1 : Button_Access := New_Button (Parent => Box_To_Widget(My_H_Box), Text => "Ada", Exclusive => True); My_Button_2 : Button_Access := New_Button (Parent => Box_To_Widget(My_H_Box), Text => "Hello!", Exclusive => True); My_Checkbox_1 : Checkbox_Access := New_Checkbox (Parent => Box_To_Widget(My_V_Box), Text => "Checkbox #1", Init_State => True, Exclusive => True); My_Checkbox_2 : Checkbox_Access := New_Checkbox (Parent => Box_To_Widget(My_V_Box), Text => "Checkbox #2", Exclusive => True); begin T_IO.Put_Line ("Box created: " & AGO.Get_Name(Box_To_Object(My_V_Box))); T_IO.Put_Line ("Button #1 created: " & AGO.Get_Name(Button_To_Object(My_Button_1))); T_IO.Put_Line ("Button #2 created: " & AGO.Get_Name(Button_To_Object(My_Button_2))); T_IO.Put_Line ("Checkbox #1 created: " & AGO.Get_Name(Checkbox_To_Object(My_Checkbox_1))); T_IO.Put_Line ("Checkbox #2 created: " & AGO.Get_Name(Checkbox_To_Object(My_Checkbox_2))); end; -- Adjust window borders (normally used in single-window mode) -- --AGW.Set_Window_Borders -- (Window => My_Window, -- W_Sides => 10); -- Hide window on close request -- -- AGW.Set_Window_Close_Action(My_Window, AGW.HIDE_WINDOW); -- Destroy window on close request -- AGW.Set_Window_Close_Action(My_Window, AGW.DETACH_WINDOW); -- Make the window visible -- AGW.Show_Window(My_Window); -- Move the window by +100,-200 pixels -- -- AGW.Move_Window(My_Window, +100, -200); -- Set the minimum window size. -- AGW.Set_Window_Minimum_Size(My_Window, 200, 100); -- AGW.Set_Window_Minimum_Size_Pct(My_Window, 50, 33); -- Set an explicit window size and position in pixels. -- AGW.Set_Window_Geometry -- (Window => My_Window, -- X => 10, -- Y => 10, -- W => 420, -- H => 340); -- Set the window size (in pixels) and desktop alignment. -- AGW.Set_Window_Geometry_Aligned -- (Window => My_Window, -- Alignment => AGW.MIDDLE_CENTER, -- W => 420, -- H => 340); -- Set the window size (in % of desktop area) and desktop alignment. AGW.Set_Window_Geometry_Aligned_Pct (Window => My_Window, Alignment => AGW.MIDDLE_CENTER, W_Pct => 50, H_Pct => 33); -- Compute the alignment offset of a window in pixels. declare X_Align : Integer; Y_Align : Integer; begin AGW.Compute_Window_Alignment(My_Window, X_Align, Y_Align); T_IO.Put_Line ("Window alignment: X =" & X_Align'Img & " Y =" & Y_Align'Img); end; -- Set the opacity of a window (for compositing WM). -- AGW.Set_Window_Opacity(My_Window, 0.5); -- Enable window slow fade-in (for compositing WM). -- AGW.Set_Window_Fade_In(My_Window, 0.06, 0.2); -- AGW.Set_Window_Fade_Out(My_Window, 0.06, 0.2); -- Set the zoom level on a window. -- AGW.Set_Window_Zoom(My_Window, 85); -- Maximize/minimize the window. -- AGW.Maximize_Window(My_Window); -- AGW.Minimize_Window(My_Window); -- Lower/raise the window's Z-order. -- AGW.Lower_Window(My_Window); -- AGW.Raise_Window(My_Window); end; -- -- Enter the standard Agar event loop. -- T_IO.Put_Line ("Entering event loop at" & Duration'Image(RT.To_Duration(RT.Clock - Epoch)) & "s"); Agar.Event_Loop.Event_Loop; T_IO.Put_Line ("Exiting after" & Duration'Image(RT.To_Duration(RT.Clock - Epoch)) & "s"); Agar.Init.Quit; end agar_ada_demo;