feat(ada): implement

ada/main.adb

@@ -0,0 +1,147 @@
+with Interfaces.C;         use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Ada.Calendar;
+with System;
+
+procedure Main is
+
+   WINDOW_WIDTH  : constant := 800;
+   WINDOW_HEIGHT : constant := 600;
+   LOGO_HEIGHT   : constant := 64;
+   LOGO_SPEED    : constant float := 300.0;
+
+   type Unsigned_Char is mod 2 ** 8;
+   for Unsigned_Char'Size use 8;
+
+   type Color is record
+      R, G, B, A : Unsigned_Char;
+   end record;
+   pragma Convention (C_Pass_By_Copy, Color);
+
+   type Vector2 is record
+      X, Y : float;
+   end record;
+   pragma Convention (C_Pass_By_Copy, Vector2);
+
+   type Image is record
+      Data    : System.Address;
+      Width   : int;
+      Height  : int;
+      Mipmaps : int;
+      Format  : int;
+   end record;
+   pragma Convention (C_Pass_By_Copy, Image);
+
+   type Texture2D is record
+      Id      : unsigned;
+      Width   : int;
+      Height  : int;
+      Mipmaps : int;
+      Format  : int;
+   end record;
+   pragma Convention (C_Pass_By_Copy, Texture2D);
+
+   BLACK : constant Color := (R => 0,   G => 0,   B => 0,   A => 255);
+   WHITE : constant Color := (R => 255, G => 255, B => 255, A => 255);
+
+   procedure Init_Window (Width : int; Height : int; Title : chars_ptr);
+   pragma Import (C, Init_Window, "InitWindow");
+
+   procedure Set_Target_FPS (Fps : int);
+   pragma Import (C, Set_Target_FPS, "SetTargetFPS");
+
+   procedure Set_Random_Seed (Seed : unsigned);
+   pragma Import (C, Set_Random_Seed, "SetRandomSeed");
+
+   function Load_Image (File_Name : chars_ptr) return Image;
+   pragma Import (C, Load_Image, "LoadImage");
+
+   procedure Image_Resize (Img : access Image; New_Width : int; New_Height : int);
+   pragma Import (C, Image_Resize, "ImageResize");
+
+   function Load_Texture_From_Image (Img : Image) return Texture2D;
+   pragma Import (C, Load_Texture_From_Image, "LoadTextureFromImage");
+
+   procedure Unload_Image (Img : Image);
+   pragma Import (C, Unload_Image, "UnloadImage");
+
+   function Get_Random_Value (Min : int; Max : int) return int;
+   pragma Import (C, Get_Random_Value, "GetRandomValue");
+
+   function Window_Should_Close return int;
+   pragma Import (C, Window_Should_Close, "WindowShouldClose");
+
+   function Get_Frame_Time return float;
+   pragma Import (C, Get_Frame_Time, "GetFrameTime");
+
+   procedure Begin_Drawing;
+   pragma Import (C, Begin_Drawing, "BeginDrawing");
+
+   procedure End_Drawing;
+   pragma Import (C, End_Drawing, "EndDrawing");
+
+   procedure Clear_Background (C : Color);
+   pragma Import (C, Clear_Background, "ClearBackground");
+
+   procedure Draw_Texture_V (Tex : Texture2D; Pos : Vector2; Tint : Color);
+   pragma Import (C, Draw_Texture_V, "DrawTextureV");
+
+   procedure Unload_Texture (Tex : Texture2D);
+   pragma Import (C, Unload_Texture, "UnloadTexture");
+
+   procedure Close_Window;
+   pragma Import (C, Close_Window, "CloseWindow");
+
+   use type System.Address;
+
+   Logo_Image   : aliased Image;
+   Logo_Texture : Texture2D;
+   X, Y         : float;
+   Dx, Dy       : float;
+   Delta_Time   : float;
+   Seed         : unsigned;
+
+begin
+   Init_Window (WINDOW_WIDTH, WINDOW_HEIGHT, New_String ("Raylib in Ada"));
+   Set_Target_FPS (60);
+
+   Seed := unsigned (Ada.Calendar.Seconds (Ada.Calendar.Clock));
+   Set_Random_Seed (Seed);
+
+   Logo_Image := Load_Image (New_String ("./ada_logo.png"));
+   Image_Resize (Logo_Image'Access,
+                 Logo_Image.Width * LOGO_HEIGHT / Logo_Image.Height,
+                 LOGO_HEIGHT);
+   Logo_Texture := Load_Texture_From_Image (Logo_Image);
+   Unload_Image (Logo_Image);
+
+   X := float (Get_Random_Value (0, WINDOW_WIDTH - Logo_Texture.Width));
+   Y := float (Get_Random_Value (0, WINDOW_HEIGHT - Logo_Texture.Height));
+
+   Dx := (if Get_Random_Value (0, 1) = 1 then -LOGO_SPEED else LOGO_SPEED);
+   Dy := (if Get_Random_Value (0, 1) = 1 then -LOGO_SPEED else LOGO_SPEED);
+
+   while Window_Should_Close = 0 loop
+      Delta_Time := Get_Frame_Time;
+
+      X := X + Dx * Delta_Time;
+      Y := Y + Dy * Delta_Time;
+
+      if X < 0.0 or else X + float (Logo_Texture.Width) >= float (WINDOW_WIDTH) - 1.0 then
+         Dx := -Dx;
+         X := X + Dx * Delta_Time;
+      end if;
+      if Y < 0.0 or else Y + float (Logo_Texture.Height) >= float (WINDOW_HEIGHT) - 1.0 then
+         Dy := -Dy;
+         Y := Y + Dy * Delta_Time;
+      end if;
+
+      Begin_Drawing;
+      Clear_Background (BLACK);
+      Draw_Texture_V (Logo_Texture, (X => X, Y => Y), WHITE);
+      End_Drawing;
+   end loop;
+
+   Unload_Texture (Logo_Texture);
+   Close_Window;
+end Main;