fork download
  1. with Ada.Text_IO, Calendar;
  2. use Ada.Text_IO, Calendar;
  3.  
  4. package body Random is
  5.  
  6. X_initial : FLOAT_ITEM := 0.0;
  7. M : FLOAT_ITEM := 1.0;
  8. A : FLOAT_ITEM := 7.0;
  9. C : FLOAT_ITEM := 13.0 / 31.0;
  10.  
  11.  
  12. procedure Set_Seed is
  13. Time_And_Date : TIME;
  14. All_Day : DAY_DURATION;
  15. Minutes : FLOAT_ITEM;
  16. Int_Minutes : INTEGER;
  17. Part_Of_A_Minute : FLOAT_ITEM;
  18. begin
  19. Time_And_Date := Clock; -- Get the time and date
  20. All_Day := Seconds(Time_And_Date); -- Seconds since midnight
  21. Minutes := FLOAT_ITEM(All_Day) / 60.0; -- Floating type Minutes
  22. Int_Minutes := INTEGER(Minutes - 0.5); -- Integer type minutes
  23. Part_Of_A_Minute := FLOAT_ITEM(All_Day)
  24. - 60.0 * FLOAT_ITEM(Int_Minutes);
  25. X_Initial := 0.1;
  26. end Set_Seed;
  27.  
  28.  
  29. procedure Force_Seed(Start_Seed : FLOAT_ITEM) is
  30. Temp : FLOAT_ITEM;
  31. Natural_Temp : NATURAL;
  32. begin
  33. Natural_Temp := NATURAL(Start_Seed - 0.5);
  34. Temp := Start_Seed - FLOAT_ITEM(Natural_Temp);
  35. X_Initial := Start_Seed;
  36. exception
  37. when Constraint_Error =>
  38. Put_Line("Seed out of range, ignored");
  39. end Force_Seed;
  40.  
  41.  
  42. function Get_Seed return FLOAT_ITEM is
  43. begin
  44. return X_Initial;
  45. end Get_Seed;
  46.  
  47.  
  48. function Random_Number return FLOAT_ITEM is
  49. Temp : FLOAT_ITEM;
  50. Natural_Temp : NATURAL;
  51. begin
  52. Temp := A * X_Initial + C;
  53. Natural_Temp := NATURAL(Temp - 0.5);
  54. Temp := Temp - FLOAT_ITEM(Natural_Temp);
  55. X_Initial := Temp;
  56. return Temp;
  57. end Random_Number;
  58.  
  59. end Random;
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66. with Ada.Text_IO, Random;
  67. use Ada.Text_IO;
  68.  
  69. procedure TestRan is
  70.  
  71. package My_Random is new Random(FLOAT);
  72. use My_Random;
  73.  
  74. package Int_IO is new Ada.Text_IO.Integer_IO(INTEGER);
  75. use Int_IO;
  76. package Flt_IO is new Ada.Text_IO.Float_IO(FLOAT);
  77. use Flt_IO;
  78.  
  79. SIZE : constant := 100;
  80. type MY_ARRAY is array(1..SIZE) of INTEGER;
  81. Events : MY_ARRAY;
  82. Int_Rand : INTEGER;
  83.  
  84. begin
  85. Set_Seed;
  86. for Index in 1..2 loop
  87. Put(Random_Number, 2, 6, 0);
  88. end loop;
  89.  
  90. end TestRan;
Compilation error #stdin compilation error #stdout 0s 0KB
stdin
Standard input is empty
compilation info
gnatgcc -c -pipe -O2 prog.adb
prog.adb:66:01: end of file expected, file can have only one compilation unit
gnatmake: "prog.adb" compilation error
stdout
Standard output is empty