205 lines
6.9 KiB
Ada
205 lines
6.9 KiB
Ada
with Ada.Numerics.Elementary_Functions;
|
|
with Ada.Numerics.Discrete_Random;
|
|
|
|
with SDL.Video.Windows.Makers;
|
|
with SDL.Video.Renderers.Makers;
|
|
with SDL.Video.Surfaces;
|
|
with SDL.Video.Rectangles;
|
|
with SDL.TTFs.Makers;
|
|
with SDL.Events.Events;
|
|
with SDL.Events.Keyboards;
|
|
with SDL.Events.Mice;
|
|
|
|
procedure Honeycombs is
|
|
use SDL.Video.Rectangles;
|
|
use SDL.C;
|
|
|
|
Width : constant := 560;
|
|
Height : constant := 595;
|
|
Offset_X : constant := 10.0;
|
|
Offset_Y : constant := 40.0;
|
|
Radius : constant := 60.0;
|
|
Rows : constant := 4;
|
|
Cols : constant := 5;
|
|
TTF_File : constant String := "NotoSans-Bold.ttf";
|
|
TTF_Size_Cell : constant := 72;
|
|
TTF_Size_Sum : constant := 38;
|
|
Offset_Sum_X : constant := 35;
|
|
Offset_Sum_Y : constant := 530;
|
|
|
|
type Node_Id is mod 6;
|
|
type Shape_List is array (Node_Id) of Point;
|
|
|
|
type Cell_Info is record
|
|
Center : Point;
|
|
Marked : Boolean;
|
|
Label : String (1 .. 1);
|
|
end record;
|
|
type Cell_List is array (Positive range <>) of Cell_Info;
|
|
|
|
function Make_Shape return Shape_List is
|
|
use Ada.Numerics.Elementary_Functions;
|
|
Shape : Shape_List;
|
|
begin
|
|
for I in Shape'Range loop
|
|
Shape (I) := (X => int (Radius * Cos (Float (I), Cycle => 6.0)),
|
|
Y => int (Radius * Sin (Float (I), Cycle => 6.0)));
|
|
end loop;
|
|
return Shape;
|
|
end Make_Shape;
|
|
|
|
function Make_Cells (Rows, Cols : in Positive) return Cell_List is
|
|
subtype Label_Type is Character range 'A' .. 'Z';
|
|
package Randoms is new Ada.Numerics.Discrete_Random (Label_Type);
|
|
use Randoms;
|
|
Y_Scale : constant Float := Ada.Numerics.Elementary_Functions.Sqrt (3.0);
|
|
List : Cell_List (1 .. Rows * Cols);
|
|
Info : Cell_Info;
|
|
Gen : Generator;
|
|
begin
|
|
Reset (Gen);
|
|
for R in 1 .. Rows loop
|
|
for C in 1 .. Cols loop
|
|
Info.Center.X := int (Offset_X + Radius * 1.5 * Float (C));
|
|
Info.Center.Y := int (Offset_Y + Radius * Y_Scale * (Float (R) -
|
|
Float (C mod 2) / 2.0));
|
|
Info.Marked := False;
|
|
Info.Label (1) := Random (Gen);
|
|
List ((R - 1) * Cols + C) := Info;
|
|
end loop;
|
|
end loop;
|
|
return List;
|
|
end Make_Cells;
|
|
|
|
Window : SDL.Video.Windows.Window;
|
|
Win_Surf : SDL.Video.Surfaces.Surface;
|
|
Renderer : SDL.Video.Renderers.Renderer;
|
|
Font_Cell : SDL.TTFs.Fonts;
|
|
Font_Sum : SDL.TTFs.Fonts;
|
|
|
|
Cells : Cell_List := Make_Cells (Rows, Cols);
|
|
Shape : constant Shape_List := Make_Shape;
|
|
Sum_Text : String (1 .. Rows * Cols);
|
|
Sum_Last : Natural := Sum_Text'First - 1;
|
|
|
|
function Orient_2D (A, B, C : Point) return int is
|
|
((B.X - A.X) * (C.Y - A.Y) - (B.Y - A.Y) * (C.X - A.X));
|
|
|
|
function "+" (Left, Right : Point) return Point is
|
|
((Left.X + Right.X, Left.Y + Right.Y));
|
|
|
|
function Inside (P : Point; Cell : Cell_Info) return Boolean is
|
|
Count : Natural := 0;
|
|
begin
|
|
for Node in Shape'Range loop
|
|
Count := Count +
|
|
(if Orient_2D (Cell.Center + Shape (Node),
|
|
Cell.Center + Shape (Node + 1),
|
|
P) > 0 then 1 else 0);
|
|
end loop;
|
|
return Count = 6;
|
|
end Inside;
|
|
|
|
procedure Draw (Cell : Cell_Info) is
|
|
Surface : constant SDL.Video.Surfaces.Surface :=
|
|
Font_Cell.Render_Solid (Cell.Label, (30, 230, 230, 255));
|
|
Self_Area : SDL.Video.Rectangles.Rectangle;
|
|
Source_Area : SDL.Video.Rectangles.Rectangle := (0, 0, 0, 0);
|
|
begin
|
|
-- Fill
|
|
for Y in int (-Radius) .. int (Radius) loop
|
|
for X in int (-Radius) .. int (Radius) loop
|
|
if Inside (Cell.Center + (X, Y), Cell) then
|
|
Renderer.Draw (Point => Cell.Center + (X, Y));
|
|
end if;
|
|
end loop;
|
|
end loop;
|
|
|
|
-- Label
|
|
Self_Area := (Cell.Center.X - Surface.Size.Width / 2,
|
|
Cell.Center.Y - Surface.Size.Height / 2, 0, 0);
|
|
Win_Surf.Blit (Self_Area, Surface, Source_Area);
|
|
|
|
-- Outline
|
|
Renderer.Set_Draw_Colour ((0, 0, 0, 255));
|
|
for Id in Shape'Range loop
|
|
Renderer.Draw (Line => (Cell.Center + Shape (Id),
|
|
Cell.Center + Shape (Id + 1)));
|
|
end loop;
|
|
end Draw;
|
|
|
|
procedure Find_And_Mark (Click : Point; Key : String) is
|
|
Self_Area : SDL.Video.Rectangles.Rectangle;
|
|
Source_Area : SDL.Video.Rectangles.Rectangle := (0, 0, 0, 0);
|
|
begin
|
|
for Cell of Cells loop
|
|
if not Cell.Marked and then (Inside (Click, Cell) or Cell.Label = Key) then
|
|
Cell.Marked := True;
|
|
Sum_Last := Sum_Last + 1;
|
|
Sum_Text (Sum_Last) := Cell.Label (1);
|
|
Renderer.Set_Draw_Colour ((230, 20, 220, 255));
|
|
Draw (Cell);
|
|
|
|
-- Update sum text
|
|
Self_Area := (Offset_Sum_X, Offset_Sum_Y, 0, 0);
|
|
Win_Surf.Blit
|
|
(Self_Area, Font_Sum.Render_Solid (Sum_Text (Sum_Text'First .. Sum_Last),
|
|
(0, 200, 200, 255)), Source_Area);
|
|
Window.Update_Surface;
|
|
exit;
|
|
end if;
|
|
end loop;
|
|
end Find_And_Mark;
|
|
|
|
procedure Wait is
|
|
use type SDL.Events.Event_Types;
|
|
use SDL.Events.Keyboards;
|
|
Event : SDL.Events.Events.Events;
|
|
begin
|
|
loop
|
|
SDL.Events.Events.Wait (Event);
|
|
case Event.Common.Event_Type is
|
|
when SDL.Events.Quit => return;
|
|
when SDL.Events.Mice.Button_Down =>
|
|
Find_And_Mark
|
|
((Event.Mouse_Button.X,
|
|
Event.Mouse_Button.Y), "");
|
|
when SDL.Events.Keyboards.Key_Down =>
|
|
Find_And_Mark
|
|
((0, 0), Image (Event.Keyboard.Key_Sym.Key_Code));
|
|
null;
|
|
when others => null;
|
|
end case;
|
|
end loop;
|
|
end Wait;
|
|
|
|
begin
|
|
if not SDL.Initialise (Flags => SDL.Enable_Screen) then
|
|
return;
|
|
end if;
|
|
if not SDL.TTFs.Initialise then
|
|
null;
|
|
end if;
|
|
SDL.TTFs.Makers.Create (Font_Cell, TTF_File, TTF_Size_Cell);
|
|
SDL.TTFs.Makers.Create (Font_Sum, TTF_File, TTF_Size_Sum);
|
|
|
|
SDL.Video.Windows.Makers.Create (Win => Window,
|
|
Title => "Honeycombs",
|
|
Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
|
|
Size => SDL.Positive_Sizes'(Width, Height),
|
|
Flags => 0);
|
|
Win_Surf := Window.Get_Surface;
|
|
SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
|
|
Renderer.Set_Draw_Colour ((0, 0, 0, 255));
|
|
Renderer.Fill (Rectangle => (0, 0, Width, Height));
|
|
|
|
for Cell of Cells loop
|
|
Renderer.Set_Draw_Colour ((230, 230, 0, 255));
|
|
Draw (Cell);
|
|
end loop;
|
|
Window.Update_Surface;
|
|
|
|
Wait;
|
|
Window.Finalize;
|
|
SDL.Finalise;
|
|
end Honeycombs;
|