tomasz
/
code-examples
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Some updates.

master
Tomasz Polgrabia 2025-03-09 11:58:55 +01:00
parent a0b3856c69
commit c019a5a884
57 changed files with 2026 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
2015/2015_03/ada/README.md Normal file
View File

@ -0,0 +1,3 @@
# Ada playground
Early attempts with ada language. Unversioned, dug out from my past, almost forgotten backups.

16
2015/2015_03/ada/algorytmy/Makefile Normal file
View File

@ -0,0 +1,16 @@
SOURCES = $(wildcard *.adb)
HEADERS = $(wildcard *.ads)
PROGRAM = classes
all: build
build: $(SOURCES) $(HEADERS)
gnatmake $(PROGRAM)
.PHONY: clean
clean:
gnatclean $(PROGRAM)
rebuild:
clean build

43
2015/2015_03/ada/algorytmy/classes.adb Normal file
View File

@ -0,0 +1,43 @@
with persons;
with poles;
with workers;
with Ada.Text_IO;
with Ada.Strings.Unbounded;
with persons; use persons;
with poles; use poles;
with workers; use workers;
procedure classes is
package to renames Ada.Text_IO;
package su renames Ada.Strings.Unbounded;
type person_access is access all person'Class;
type persons_vector is array (Positive range <>) of Person_Access;
p1: aliased person;
p2: aliased pole;
w : aliased worker;
x: su.Unbounded_String;
vec: persons_vector (1 .. 3);
begin
p1.set_name(su.To_Unbounded_String("Ala"));
x := p1.get_name;
to.Put("Nazwa: ");
to.Put(su.To_String(x));
to.New_Line;
p2.set_name(su.To_Unbounded_String("Tomek"));
p2.set_pesel(su.To_Unbounded_String("90123104479"));
w.set_name(su.To_Unbounded_String("Worker 1"));
w.set_salary(1500.01);
vec(1) := p1'Access;
vec(2) := p2'Access;
vec(3) := w'Access;
for id in vec'Range loop
vec(id).greet;
end loop;
end classes;

30
2015/2015_03/ada/algorytmy/derived.adb Normal file
View File

@ -0,0 +1,30 @@
with Ada.Integer_Text_IO;
with Ada.Text_IO;
procedure derived is
package io renames Ada.Integer_Text_IO;
package to renames Ada.Text_IO;
package objects is
type Integer_1 is range 1 .. 10;
procedure print(x: Integer_1);
type Integer_2 is new Integer_1 range 8 .. 10;
end objects;
package body objects is
procedure print(x: Integer_1) is
begin
io.Put(Integer(x), Width => 0);
to.New_Line;
end print;
end objects;
x: objects.Integer_2 := 9;
begin
objects.print(x);
end derived;

105
2015/2015_03/ada/algorytmy/numerics.adb Normal file
View File

@ -0,0 +1,105 @@
with Ada.Numerics.Elementary_Functions;
with Ada.Text_IO;
with Ada.Float_Text_IO;
with Ada.Integer_Text_IO;
procedure Numerics is
procedure Quadro_Equation (
A, B, C : Float;
R1, R2 : out Float;
Valid : out Boolean) with
Pre => A /= 0.0,
Post => A /= 0.0
is
EPS: constant Float := 0.01;
package n renames Ada.Numerics.Elementary_Functions;
Z: Float;
d: Float;
begin
Z := B*B - 4.0 * A * C;
if Z < 0.0 or abs(A) < EPS then
R1 := 0.0;
R2 := 0.0;
Valid := False;
return;
end if;
d := n.Sqrt(Z);
R1 := (-B - d) / (2.0 * A);
R2 := (-B + d) / (2.0 * A);
Valid := True;
end Quadro_Equation;
R1, R2: Float;
Valid : Boolean;
function Min (
v1, v2: Integer) return Integer is
begin
if v1 < v2 then
return v1;
else
return v2;
end if;
end Min;
function Max (A, B: Integer) return Integer is
(if A >= B then A else B);
function Factorial (N: Positive) return Positive is
begin
if N <= 1 then
return 1;
else
return N * Factorial(N - 1);
end if;
end;
procedure Solve (
A, B, C : Float;
R1, R2 : out Float;
Valid : out Boolean) renames Quadro_Equation;
package to renames Ada.Text_IO;
package fo renames Ada.Float_Text_IO;
package io renames Ada.Integer_Text_IO;
X: Integer;
begin
Solve(1.0, 2.0, -1.0, R1, R2, Valid);
if Valid then
to.Put_Line("Valid");
else
to.Put_Line("Not valid");
end if;
to.Put_Line("Solutions:");
to.Put("Solution 1: ");
fo.Put(R1, EXP => 0, AFT => 2);
to.New_Line;
to.Put("Solution 2: ");
fo.Put(R2, EXP => 0, AFT => 2);
to.New_Line;
X := Min (1,2);
to.Put("min(1,2) is = ");
io.Put(X, WIDTH => 0);
to.New_Line;
X := Max (2,3);
to.Put("max(2,3) is = ");
io.Put(X, WIDTH => 0);
to.New_Line;
X := Factorial(10);
to.Put("10! is = ");
io.Put(X, WIDTH => 0);
to.New_Line;
end Numerics;

27
2015/2015_03/ada/algorytmy/persons.adb Normal file
View File

@ -0,0 +1,27 @@
package body persons is
function get_name(This: person) return su.Unbounded_String is
begin
return This.name;
end get_name;
procedure set_name(This: out person; val: su.Unbounded_String) is
begin
This.name := val;
end set_name;
procedure greet(This: person) is
name: String := su.To_String(This.get_name);
begin
if This in person then
to.Put_Line("Person type");
end if;
if This in person'Class then
to.Put_Line("Person'Clas type");
end if;
to.Put("Greets from person ");
to.Put_Line(name);
end;
end persons;

23
2015/2015_03/ada/algorytmy/persons.ads Normal file
View File

@ -0,0 +1,23 @@
with Ada.Strings.Unbounded;
with Ada.Text_IO;
package persons is
package su renames Ada.Strings.Unbounded;
package to renames Ada.Text_IO;
type person is tagged private;
function get_name(This: person) return su.Unbounded_String;
procedure set_name(This: out person; val: su.Unbounded_String);
procedure greet(This: person);
private
type person is tagged
record
name: su.Unbounded_String;
years: Integer;
end record;
end persons;

29
2015/2015_03/ada/algorytmy/poles.adb Normal file
View File

@ -0,0 +1,29 @@
package body poles is
function get_pesel(This: pole) return su.Unbounded_String is
begin
return This.pesel;
end get_pesel;
procedure set_pesel(This: out pole; val: su.Unbounded_String) is
begin
This.pesel := val;
end set_pesel;
procedure greet(This: pole) is
name: su.Unbounded_String := This.get_name;
begin
if This in person'Class then
to.Put_Line("Person'Clas type");
end if;
if This in pole then
to.Put_Line("Pole type");
end if;
to.Put("Greets from pole ");
to.Put_Line(su.To_String(name));
end;
end poles;

24
2015/2015_03/ada/algorytmy/poles.ads Normal file
View File

@ -0,0 +1,24 @@
with persons; use persons;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
package poles is
package su renames Ada.Strings.Unbounded;
package to renames Ada.Text_IO;
type pole is new persons.person with private;
function get_pesel(This: pole) return su.Unbounded_String;
procedure set_pesel(This: out pole; val: su.Unbounded_String);
overriding procedure greet(This: pole);
private
type pole is new persons.person
with
record
pesel: su.Unbounded_String;
end record;
end poles;

56
2015/2015_03/ada/algorytmy/program.adb Normal file
View File

@ -0,0 +1,56 @@
with Ada.Text_IO;
with Ada.Integer_Text_IO;
with Ada.Float_Text_IO;
with Ada.Command_Line;
with Ada.Strings;
with Ada.Strings.Unbounded;
procedure program is
package to renames Ada.Text_IO;
package io renames Ada.Integer_Text_IO;
package fo renames Ada.Float_Text_IO;
package s renames Ada.Strings;
package su renames Ada.Strings.Unbounded;
package cl renames Ada.Command_Line;
type Degrees is new Float range -273.15 .. Float'Last;
Temperature: Degrees;
begin
declare
X: su.Unbounded_String := su.To_Unbounded_String(cl.Argument(1));
begin
Temperature := 36.6;
to.Put("Hello, World!!!. The temperature is: ");
fo.Put(Float(Temperature), EXP => 0, AFT => 2);
to.New_Line;
if Temperature >= 40.0 then
to.Put_Line("Wow!");
to.Put_Line("It's extremly hot");
elsif Temperature >= 30.0 then
to.Put_Line("It's hot");
elsif Temperature >= 20.0 then
to.Put_Line("It's warm");
elsif Temperature >= 10.0 then
to.Put_Line("It's cool");
elsif Temperature >= 0.0 then
to.Put_Line("It's cold");
else
to.Put_Line("It's freezing");
end if;
to.Put("Argument 1: ");
to.Put_Line(su.To_String(X));
X := su.To_Unbounded_String(cl.Argument(2));
to.Put("Argument 2: ");
to.Put_Line(su.To_String(X));
end;
exception
when CONSTRAINT_ERROR =>
to.Put_Line("Niepoprawne wywołanie programu");
end program;

94
2015/2015_03/ada/algorytmy/sockets.adb Normal file
View File

@ -0,0 +1,94 @@
with Ada.Text_IO;
with GNAT.Sockets;
with Ada.Strings.Unbounded;
with Ada.Streams;
with Ada.Unchecked_Conversion;
procedure sockets is
package to renames Ada.Text_IO;
package s renames GNAT.Sockets;
package su renames Ada.Strings.Unbounded;
package as renames Ada.Streams;
host : constant String := "www.wp.pl";
HTTP_PORT : constant s.PORT_TYPE := 80;
task ping is
entry start;
entry stop;
end ping;
task body ping is
query : su.Unbounded_String := su.To_Unbounded_String("");
host2 : su.Unbounded_String;
Address : s.Sock_Addr_Type;
Socket : s.Socket_Type;
Channel : s.Stream_Access;
cr : constant Character := Character'Val(13);
lf : constant Character := Character'Val(10);
new_line : constant String := (cr, lf);
output : as.Stream_Element_Array (1 .. 16#1000#);
last : as.Stream_Element_Offset;
output2 : su.Unbounded_String;
begin
to.Put("Ala");
to.Put(new_line);
to.Put("Kot");
accept start;
Address.Addr := s.Addresses (s.Get_Host_By_Name (host), 1);
Address.Port := HTTP_PORT;
s.Create_Socket (Socket);
s.Set_Socket_Option (
Socket,
s.Socket_Level,
(s.Reuse_Address, True));
delay 0.2;
to.Put_Line("Lacze z hostem");
s.Connect_Socket(Socket, Address);
Channel := s.Stream (Socket);
to.Put_Line("Wysylam dane");
su.Append(query, "GET / HTTP/1.1" & new_line);
su.Append(query, "Host: " & host & new_line);
su.Append(query, "Connection: close" & new_line);
su.Append(query, new_line);
String'Write(Channel, su.To_String(query));
to.Put_Line("Odbieram dane");
loop
su.Delete(output2, 1, su.Length(output2));
as.Read(Channel.All,
output,
last);
exit when Integer(last) = 0;
declare
subtype Output_String is String (1 .. Integer(last));
function Convert is new Ada.Unchecked_Conversion(
Source => as.Stream_Element_Array,
Target => Output_String);
begin
to.Put_Line(Convert(output (1 .. last)));
end;
end loop;
to.Put_Line("Zamykam gniazdo");
s.Close_Socket(Socket);
accept stop;
to.Put_Line("ping stopped");
end ping;
begin
to.Put_Line("Hello World!!!");
ping.start;
ping.stop;
end sockets;

53
2015/2015_03/ada/algorytmy/tasks.adb Normal file
View File

@ -0,0 +1,53 @@
with Ada.Text_IO;
procedure tasks is
package to renames Ada.Text_IO;
task type counter1 is
entry Greet(s: String);
end;
task type counter2 is
entry Greet(s: String);
end;
task body counter1 is
begin
loop
select
accept Greet(s: String) do
to.Put("Task 1 accepted greeting string: ");
to.Put_Line(s);
end Greet;
to.Put_Line("Task 1 loop counter");
or
terminate;
end select;
to.Put_Line("Task 1 finish");
end loop;
end counter1;
task body counter2 is
begin
loop
select
accept Greet(s: String) do
to.Put("Task 2 accepted greeting string: ");
to.Put_Line(s);
end Greet;
to.Put_Line("Task 2 loop counter");
or
terminate;
end select;
to.Put_Line("Task 2 finish");
end loop;
end counter2;
c1: counter1;
c2: counter2;
begin
c1.greet("Ala 1");
c2.greet("Ala 2");
to.Put_Line("Tasks finished");
end tasks;

9
2015/2015_03/ada/algorytmy/tmp.adb Normal file
View File

@ -0,0 +1,9 @@
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure tmp is
begin
Put("Rozmiar standard: ");
Put(Standard'Storage_Unit, Width => 0);
New_Line;
end tmp;

24
2015/2015_03/ada/algorytmy/workers.adb Normal file
View File

@ -0,0 +1,24 @@
package body workers is
function get_salary(this: worker) return Float is
begin
return this.salary;
end get_salary;
procedure set_salary(this: out worker;
val: Float) is
begin
this.salary := val;
end set_salary;
procedure greet(this: worker) is
begin
to.Put("Pozdrowienia od pracownika ");
to.Put(su.To_String(this.get_name));
to.Put(". Zarabiam ");
fo.Put(this.salary, EXP => 0, AFT => 0);
to.Put_Line(" miesiecznie.");
end greet;
end workers;

25
2015/2015_03/ada/algorytmy/workers.ads Normal file
View File

@ -0,0 +1,25 @@
with persons;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Ada.Float_Text_IO;
package workers is
package su renames Ada.Strings.Unbounded;
package to renames Ada.Text_IO;
package fo renames Ada.Float_Text_IO;
type worker is new persons.person with private;
function get_salary(this: worker) return Float;
procedure set_salary(this: out worker; val: Float);
overriding procedure greet(this: worker);
private
type worker is new persons.person with
record
salary: Float;
end record;
end workers;

7
2015/2015_03/ada/directory.ads Normal file
View File

@ -0,0 +1,7 @@
package Directory is
function Present (Name_Pattern: String) return Boolean;
generic
with procedure Visit (Full_Name, Phone_Number, Address: String;
Stop: out Boolean);
procedure Iterate (Name_Pattern: String);
end Directory;

9
2015/2015_03/ada/nauka/1/Makefile Normal file
View File

@ -0,0 +1,9 @@
all: hello
hello: hello.adb
gnatmake hello.adb
.PHONY: clean
clean:
rm -f *.ali *.o hello

6
2015/2015_03/ada/nauka/1/hello.adb Normal file
View File

@ -0,0 +1,6 @@
with Ada.Text_IO;
procedure Hello is
begin
Ada.Text_IO.Put_Line("Hello, world");
end Hello;

9
2015/2015_03/ada/nauka/2/Makefile Normal file
View File

@ -0,0 +1,9 @@
all: hello
hello: hello.adb
gnatmake hello.adb
.PHONY: clean
clean:
rm -f *.ali *.o hello

7
2015/2015_03/ada/nauka/2/hello.adb Normal file
View File

@ -0,0 +1,7 @@
with Ada.Text_IO;
procedure Hello is
package IO renames Ada.Text_IO;
begin
IO.Put_Line("Hello, world");
end Hello;

9
2015/2015_03/ada/nauka/3/Makefile Normal file
View File

@ -0,0 +1,9 @@
all: hello
hello: hello.adb
gnatmake hello.adb
.PHONY: clean
clean:
rm -f *.ali *.o hello

8
2015/2015_03/ada/nauka/3/hello.adb Normal file
View File

@ -0,0 +1,8 @@
with Ada.Text_IO;
use Ada.Text_IO;
procedure Hello is
package IO renames Ada.Text_IO;
begin
Put_Line("Hello, world");
end Hello;

9
2015/2015_03/ada/nauka/SPOJ/Makefile Normal file
View File

@ -0,0 +1,9 @@
all: bajtek
bajtek: bajtek.adb
gnatmake $<
.PHONY: clean
clean:
rm -f *.o *.ali bajtek

198
2015/2015_03/ada/nauka/SPOJ/bajtek.adb Normal file
View File

@ -0,0 +1,198 @@
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Strings.Fixed;
with Ada.Integer_Text_IO;
-- Nie działa to poprawnie
procedure bajtek is
package T_IO renames Ada.Text_IO;
package CL renames Ada.Command_Line;
package S renames Ada.Strings;
package SF renames Ada.Strings.Fixed;
package I_IO renames Ada.Integer_Text_IO;
function FindFirstEqual(
str: String;
c: Character;
from: Integer) return Integer is
begin
FindCharacter:
for i in Natural range from .. str'Last loop
if str(i) = c then
return i;
end if;
end loop FindCharacter;
return -1;
end FindFirstEqual;
function FindFirstNotEqual(
str: String;
c: Character;
from: Integer) return Integer is
begin
FindCharacter:
for i in Natural range from .. str'Last loop
if str(i) /= c or str(i) = Character'Val(0) then
return i;
end if;
end loop FindCharacter;
return -1;
end FindFirstNotEqual;
PartsLength : constant := 100;
BlackPerformance: constant := 10.0;
GrayPerformance: constant := 6.00;
subtype ICM is Integer;
subtype FCM2 is Float;
beginningX: constant := -10;
beginningY: constant := -10;
subtype xType is ICM range beginningX .. 10000;
subtype yType is ICM range beginningY .. 10000;
procedure FindNextPoint(
str: in String;
from: in out Integer;
pointX: out xType;
pointY: out yType;
found: out Boolean) is
f,t: Integer := from;
begin
f := FindFirstNotEqual(str,S.Space, f);
if f < 0 then
found := false;
return;
end if;
t := FindFirstEqual(str,S.Space,f+1);
if t < 0 then
found := false;
return;
end if;
pointX := xType'Value(str(f .. t-1));
f := t;
f := FindFirstNotEqual(str,S.Space, f);
if f < 0 then
found := false;
return;
end if;
t := FindFirstEqual(str,S.Space,f+1);
if t < 0 then
t := FindFirstEqual(str, Character'Val(0), f+1);
end if;
pointY := yType'Value(str(f .. t-1));
from := t;
found := true;
end FindNextPoint;
-- ala ma kota
X : String (1..1000);
Length : Integer;
CurrentX,LastX : xType := beginningX;
CurrentY,LastY : yType := beginningY;
Field: Float := 0.0;
found: Boolean;
FieldWhite,FieldBlack: FCM2;
NrPaintings : Integer;
BlackBitoKule,GrayBitoKule: Float := 0.0;
i: Integer;
function strlen(s : String) return Integer is
pos : Integer := s'First;
begin
SearchNull:
while pos < s'Last and s(pos) /= Character'Val(0) loop
pos := pos + 1;
end loop SearchNull;
return pos-s'First;
end strlen;
begin
T_IO.Put_Line("Put nr of lines");
T_IO.Get_Line(X,Length);
NrPaintings := Integer'Value(X(X'First .. Length));
T_IO.Put_Line("Put data");
ReadingLines:
for line in Integer range 1 .. 2*NrPaintings loop
exit ReadingLines when T_IO.End_Of_File;
T_IO.Get_Line(X, Length);
SF.Move(
X(X'First..Length),
X,
S.Right,
S.Left,
Character'Val(0));
i := X'First;
LastX := beginningX;
LastY := beginningY;
Field := 0.0;
IfNotAllPointsRead:
while i <= Length loop
FindNextPoint(
X,
i,
CurrentX,
CurrentY,
found);
if found = false then
exit IfNotAllPointsRead;
end if;
T_IO.Put_Line("Wczytano punkt ("
& xType'Image(CurrentX) & ","
& yType'Image(CurrentY) & ")");
Field := Field
+ Float((CurrentY + LastX) * (CurrentX - LastX)) / 2.0;
LastX := CurrentX;
LastY := CurrentY;
end loop IfNotAllPointsRead;
if line mod 2 = 0 then
-- opis czarnego
FieldBlack := Field;
BlackBitoKule := BlackBitoKule + FieldBlack * BlackPerformance;
else
-- opis szarego
FieldWhite := Field-FieldBlack; -- pomijamy czarny zawarty
GrayBitoKule := GrayBitoKule + FieldWhite * GrayPerformance;
end if;
end loop ReadingLines;
T_IO.Put_Line(Integer'Image(Integer(Float'Rounding(BlackBitoKule))));
T_IO.Put_Line(Integer'Image(Integer(Float'Rounding(GrayBitoKule))));
end bajtek;

8
2015/2015_03/ada/nauka/SPOJ_PA05_POT/Makefile Normal file
View File

@ -0,0 +1,8 @@
all: exp
exp: exp.adb
gnatmake -gnat95 $<
.PHONY: clean
clean:
rm -f *.o *.ali cl4 b~*

132
2015/2015_03/ada/nauka/SPOJ_PA05_POT/exp.adb Normal file
View File

@ -0,0 +1,132 @@
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Strings.Fixed;
with Ada.Integer_Text_IO;
with Ada.IO_Exceptions;
with Ada.Task_Identification; use Ada.Task_Identification;
procedure exp is
package T_IO renames Ada.Text_IO;
package CL renames Ada.Command_Line;
package S renames Ada.Strings;
package SF renames Ada.Strings.Fixed;
package I_IO renames Ada.Integer_Text_IO;
type LargeInt is range 0 .. 1000000000;
function GetLine (length: Integer := 1000) return String is
Line: String(1 .. length);
Last: Integer;
begin
T_IO.Get_Line(Line, Last);
return Line(1 .. Last);
end GetLine;
PartsLength : constant := 100;
X : String (1..1000);
Pos, Length2, Length : Integer;
Part1, Part2: String (1 .. PartsLength);
base: Integer;
exponent : LargeInt;
function strlen(s : String) return Integer is
pos : Integer := s'First;
begin
SearchNull:
while pos < s'Last and s(pos) /= Character'Val(0) loop
pos := pos + 1;
end loop SearchNull;
return pos-s'First;
end strlen;
procedure ReadLine(str : in out String) is
begin
SF.Move(
GetLine,
str,
S.Right,
S.Left,
Character'Val(0));
end ReadLine;
type LastDigit is range 0 .. 9;
function GetLastDigit (base : Integer; exponent : LargeInt) return LastDigit is
temp : Integer := 1;
digit: LastDigit := LastDigit(base mod 10);
type Matrix is array (LastDigit, Integer range 0 .. 3) of LastDigit;
tab : Matrix :=
(
0 => (0, 0, 0, 0),
1 => (1, 1, 1, 1),
2 => (2, 4, 8, 6),
3 => (3, 9, 7, 1),
4 => (4, 6, 4, 6),
5 => (5, 5, 5, 5),
6 => (6, 6, 6, 6),
7 => (7, 9, 3, 1),
8 => (8, 4, 2, 6),
9 => (9, 1, 9, 1)
);
begin
if exponent <= 0 then
return 1;
end if;
return tab(digit,Integer((exponent-1) mod 4) );
end GetLastDigit;
digit : LastDigit;
lines: Integer;
begin
lines := Integer'Value(GetLine);
ReadingLines:
for i in Integer range 1 .. lines loop
exit ReadingLines when T_IO.End_Of_File;
ReadLine(X);
Length := strlen(X);
Pos := SF.Index(X," ");
Length2 := Length - Pos ;
SF.Move(
X(1..Pos-1),
Part1,
S.Right,
S.Left,
Character'Val(0));
SF.Move(
X(Pos+1 .. Pos+Length2),
Part2,
S.Right,
S.Left,
Character'Val(0));
base := Integer'Value(Part1(1..Pos-1));
exponent := LargeInt'Value(Part2(1..Length2));
digit := GetLastDigit(base,exponent);
I_IO.Put(Integer(digit),0);
T_IO.New_Line;
end loop ReadingLines;
exception
when Ada.IO_Exceptions.End_Error =>
null;
when Error : others =>
T_IO.Put_Line("Improper data format");
end exp;

16
2015/2015_03/ada/nauka/calling_libc/call.adb Normal file
View File

@ -0,0 +1,16 @@
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
procedure call is
function kill (pid: Integer; signal: Integer) return Integer;
pragma Import (C, kill, "kill");
res: Integer;
begin
res := kill(2,3);
if res /= 0 then
Put_Line("Blad");
else
Put_Line("Sukces");
end if;
end call;

27
2015/2015_03/ada/nauka/cl/cl1.adb Normal file
View File

@ -0,0 +1,27 @@
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Strings.Fixed;
procedure cl2 is
package T_IO renames Ada.Text_IO;
package CL renames Ada.Command_Line;
package S renames Ada.Strings;
package SF renames Ada.Strings.Fixed;
X : String := CL.Argument (1);
begin
T_IO.Put ("Argument 1 = ");
T_IO.Put_Line (X);
SF.Move (
Source => CL.Argument (2),
Target => X,
Drop => S.Right,
Justify => S.Left,
Pad => S.Space);
T_IO.Put ("Argument 2 = ");
T_IO.Put_Line (X);
end cl2;

37
2015/2015_03/ada/nauka/cl/cl3.adb Normal file
View File

@ -0,0 +1,37 @@
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Strings.Fixed;
procedure cl3 is
package T_IO renames Ada.Text_IO;
package CL renames Ada.Command_Line;
package S renames Ada.Strings;
package SF renames Ada.Strings.Fixed;
X : String (1..1000);
begin
SF.Move (
Source => CL.Argument (1),
Target => X,
Drop => S.Right,
Justify => S.Left,
Pad => Character'Val(0));
T_IO.Put ("Argument 1 = ");
T_IO.Put (X);
SF.Move (
Source => CL.Argument (2),
Target => X,
Drop => S.Right,
Justify => S.Left,
Pad => Character'Val(0));
T_IO.Put ("Argument 2 = ");
T_IO.Put_Line (X);
end cl3;

9
2015/2015_03/ada/nauka/cond_structures/Makefile Normal file
View File

@ -0,0 +1,9 @@
all: hello
hello: hello.adb
gnatmake hello.adb
.PHONY: clean
clean:
rm -f *.ali *.o hello

16
2015/2015_03/ada/nauka/cond_structures/hello.adb Normal file
View File

@ -0,0 +1,16 @@
with Ada.Text_IO;
use Ada.Text_IO;
with Ada.Command_Line;
use Ada.Command_Line;
procedure Hello is
package IO renames Ada.Text_IO;
i: Integer := 3;
begin
Put_Line("Hello, world");
if i < 2 then
Put_Line("Mniejsze od 2 ");
else
Put_Line("Większe lub równe 2");
end if;
end Hello;

9
2015/2015_03/ada/nauka/cond_structures2/Makefile Normal file
View File

@ -0,0 +1,9 @@
all: hello
hello: hello.adb
gnatmake hello.adb
.PHONY: clean
clean:
rm -f *.ali *.o hello

61
2015/2015_03/ada/nauka/cond_structures2/hello.adb Normal file
View File

@ -0,0 +1,61 @@
with Ada.Text_IO;
use Ada.Text_IO;
with Ada.Command_Line;
use Ada.Command_Line;
with Ada.Integer_Text_IO;
use Ada.Integer_Text_IO;
procedure Hello is
package IO renames Ada.Text_IO;
i: Integer := 2;
j: Integer := 1;
k: Integer;
procedure Add (A, B: in Integer; C: out Integer) is
begin
C := A + B;
end Add;
function Subtract(A, B: Integer) return Integer is
begin
return A - B;
end Subtract;
function Factorial(X: Integer) return Integer is
begin
if x <= 1 then
return 1;
end if;
return X * Factorial(X-1);
end Factorial;
begin
Put_Line("Hello, world");
Add(i,j,k);
k := Subtract(k,1);
case k is
when 1 =>
Put_Line("i ma wartosc 1");
when 2 =>
Put_Line("i ma wartosc 2");
when 3 =>
Put_Line("i ma wartosc 3");
when others =>
Put_Line("i ma niespotykaną wartość");
end case;
New_Line(1);
Put("Ala ma ");
Put(Factorial(5),0);
Put(" kotów");
New_Line;
K := Integer(2.4);
Put("Skonwertowane 2.5 to: ");
Put(K,0);
New_Line;
end Hello;

9
2015/2015_03/ada/nauka/io/Makefile Normal file
View File

@ -0,0 +1,9 @@
all: hello
hello: hello.adb
gnatmake hello.adb
.PHONY: clean
clean:
rm -f *.ali *.o hello

25
2015/2015_03/ada/nauka/io/hello.adb Normal file
View File

@ -0,0 +1,25 @@
with Ada.Text_IO;
use Ada.Text_IO;
procedure Hello is
package IO renames Ada.Text_IO;
function GetLine return String is
Line : String(1 .. 1000);
Last : Integer;
begin
Get_Line(Line,Last);
return Line(1 .. Last);
end GetLine;
Line: String(1 .. 200);
begin
Line.Overwrite("A",0);
New_Line;
end Hello;

9
2015/2015_03/ada/nauka/objects/Makefile Normal file
View File

@ -0,0 +1,9 @@
all: hello
hello: hello.adb
gnatmake hello.adb
.PHONY: clean
clean:
rm -f *.ali *.o hello

23
2015/2015_03/ada/nauka/objects/hello.adb Normal file
View File

@ -0,0 +1,23 @@
with Ada.Text_IO;
use Ada.Text_IO;
with Ada.Command_Line;
use Ada.Command_Line;
procedure Hello is
package IO renames Ada.Text_IO;
package Obj is
type A is tagged record
p: Integer;
end record;
end Obj;
i : Integer := 1;
ooops: Obj.A;
begin
Put_Line("Hello, world");
if i < 2 then
Put_Line("Mniejsze od 2 ");
else
Put_Line("Większe lub równe 2");
end if;
end Hello;

72
2015/2015_03/ada/nauka/parse/; Normal file
View File

@ -0,0 +1,72 @@
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Strings.Fixed;
with Ada.Integer_Text_IO;
procedure cl4 is
package T_IO renames Ada.Text_IO;
package CL renames Ada.Command_Line;
package S renames Ada.Strings;
package SF renames Ada.Strings.Fixed;
package I_IO renames Ada.Integer_Text_IO;
function GetLine (length: Integer := 1000) return String is
Line: String(1 .. length);
Last: Integer;
begin
T_IO.Get_Line(Line, Last);
return Line(1 .. Last);
end GetLine;
PartsLength : constant := 100;
X : String (1..1000);
Pos : Integer;
Part1, Part2: String (1 .. PartsLength);
Val1, Val2: Integer;
begin
T_IO.Put_Line("Próba wczytania tekstu ;)");
ReadingLines:
loop
SF.Move(
GetLine,
X,
S.Right,
S.Left,
Character'Val(0));
T_IO.Put_Line ("Wczytano: '" & X & "'");
Pos := SF.Index(
X,
" ");
T_IO.Put_Line ("Przerwe znaleziono na miejscu: " & Integer'Image(Pos));
SF.Move(
X(1..Pos-1),
Part1,
S.Right,
S.Left,
Character'Val(0));
SF.Move(
X(Pos+1 .. X'Last),
Part2,
S.Right,
S.Left,
Character'Val(0));
T_IO.Put_Line ("1. Czesc: '" & Part1(1..Pos-1) & "', 2. Czesc: '" & Part2(1..X'last-Pos-1) & "'");
Val1 := Integer'Value(Part1(1..Pos-1));
Val2 := Integer'Value(Part2(1..X'last-Pos-1));
exit ReadingLines when T_IO.End_Of_File;
end loop ReadingLines;
end cl4;

27
2015/2015_03/ada/nauka/parse/cl1.adb Normal file
View File

@ -0,0 +1,27 @@
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Strings.Fixed;
procedure cl2 is
package T_IO renames Ada.Text_IO;
package CL renames Ada.Command_Line;
package S renames Ada.Strings;
package SF renames Ada.Strings.Fixed;
X : String := CL.Argument (1);
begin
T_IO.Put ("Argument 1 = ");
T_IO.Put_Line (X);
SF.Move (
Source => CL.Argument (2),
Target => X,
Drop => S.Right,
Justify => S.Left,
Pad => S.Space);
T_IO.Put ("Argument 2 = ");
T_IO.Put_Line (X);
end cl2;

37
2015/2015_03/ada/nauka/parse/cl3.adb Normal file
View File

@ -0,0 +1,37 @@
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Strings.Fixed;
procedure cl3 is
package T_IO renames Ada.Text_IO;
package CL renames Ada.Command_Line;
package S renames Ada.Strings;
package SF renames Ada.Strings.Fixed;
X : String (1..1000);
begin
SF.Move (
Source => CL.Argument (1),
Target => X,
Drop => S.Right,
Justify => S.Left,
Pad => Character'Val(0));
T_IO.Put ("Argument 1 = ");
T_IO.Put (X);
SF.Move (
Source => CL.Argument (2),
Target => X,
Drop => S.Right,
Justify => S.Left,
Pad => Character'Val(0));
T_IO.Put ("Argument 2 = ");
T_IO.Put_Line (X);
end cl3;

90
2015/2015_03/ada/nauka/parse/cl4.adb Normal file
View File

@ -0,0 +1,90 @@
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Strings.Fixed;
with Ada.Integer_Text_IO;
procedure cl4 is
package T_IO renames Ada.Text_IO;
package CL renames Ada.Command_Line;
package S renames Ada.Strings;
package SF renames Ada.Strings.Fixed;
package I_IO renames Ada.Integer_Text_IO;
function GetLine (length: Integer := 1000) return String is
Line: String(1 .. length);
Last: Integer;
begin
T_IO.Get_Line(Line, Last);
return Line(1 .. Last);
end GetLine;
PartsLength : constant := 100;
X : String (1..1000);
Pos, Length2, Length : Integer;
Part1, Part2: String (1 .. PartsLength);
Val1, Val2: Integer;
function strlen(s : String) return Integer is
pos : Integer := s'First;
begin
SearchNull:
while pos < s'Last and s(pos) /= Character'Val(0) loop
pos := pos + 1;
end loop SearchNull;
return pos-s'First;
end strlen;
begin
T_IO.Put_Line("Próba wczytania tekstu ;)");
ReadingLines:
loop
SF.Move(
GetLine,
X,
S.Right,
S.Left,
Character'Val(0));
Length := strlen(X);
T_IO.Put_Line ("Wczytano: '" & X & "', Length: " &
Integer'Image(Length));
Pos := SF.Index(X," ");
Length2 := Length - Pos ;
T_IO.Put_Line ("Przerwe znaleziono na miejscu: " & Integer'Image(Pos)
& ", Length2: " & Integer'Image(Length2));
SF.Move(
X(1..Pos-1),
Part1,
S.Right,
S.Left,
Character'Val(0));
SF.Move(
X(Pos+1 .. Pos+Length2),
Part2,
S.Right,
S.Left,
Character'Val(0));
T_IO.Put_Line ("1. Czesc: '" & Part1 & "', 2. Czesc: '" & Part2 & "'");
Val1 := Integer'Value(Part1(1..Pos-1));
Val2 := Integer'Value(Part2(1..Length2));
T_IO.Put_Line("Val1: " & Integer'Image(Val1) & ", Val2: "
& Integer'Image(Val2));
exit ReadingLines when T_IO.End_Of_File;
end loop ReadingLines;
end cl4;

BIN
2015/2015_03/ada/pingwiny/pingwiny.a Normal file
View File

Binary file not shown.

147
2015/2015_03/ada/pingwiny/pingwiny.adb Normal file
View File

@ -0,0 +1,147 @@
with Ada.Text_IO;
with Ada.Integer_Text_IO;
procedure pingwiny is
package T_IO renames Ada.Text_IO;
package I_IO renames Ada.Integer_Text_IO;
type Pingwin is record
x: Natural;
y: Natural;
end record;
type Macierz is array (Positive range<>, Positive range<>) of Natural;
type Wektor is array (Positive range <>) of Pingwin;
procedure Symuluj(Plansza: Macierz; Pingwiny: Wektor) is
function Finish return Boolean is
function SprawdzPingwina(nr: Positive) return Boolean is
WolnePola : Integer := 0;
Fields: constant array (1 .. 6, 1 .. 2) of Integer :=
(
1 => (0,-1), -- górny lewy
2 => (1,-1), -- górny prawy
3 => (-1,0), -- środkowy lewy
4 => (1,0), -- środkowy prawy
5 => (0,1), -- dolny lewy
6 => (-1,1) -- dolny prawy
);
x: Integer;
y: Integer;
begin
SprawdzPola:
for i in Fields'Range loop
x := Pingwiny(i).x + Fields(i,1);
y := Pingwiny(i).y + Fields(i,2);
if not (x in Plansza'Range(2)) or not (y in Plansza'Range(1)) then
WolnePola := WolnePola + 1;
end if;
end loop SprawdzPola;
return true;
end SprawdzPingwina;
MozliwyRuch: Boolean := false;
begin
SprawdzPingwiny:
for i in Pingwiny'Range loop
if not (SprawdzPingwina(i)) then
MozliwyRuch := true;
exit SprawdzPingwiny;
end if;
end loop SprawdzPingwiny;
return not(MozliwyRuch);
end Finish;
begin
T_IO.Put_Line("Symulację czas zacząć");
SymulacjaPetla:
while not(Finish) loop
null;
end loop SymulacjaPetla;
null;
end Symuluj;
LiczbaPingwinow, LiczbaKier, Wysokosc, Szerokosc: Positive;
begin
T_IO.Put("Podaj dane: (Liczba pinginow, Liczba kier, Wysokosc, Szerokosc): ");
I_IO.Get(Item => LiczbaPingwinow);
I_IO.Get(Item => LiczbaKier);
I_IO.Get(Item => Wysokosc);
I_IO.Get(Item => Szerokosc);
T_IO.Put("Pingwinow: ");
I_IO.Put(Item => LiczbaPingwinow, Width => 0);
T_IO.New_Line;
T_IO.Put("Wymiary to: (");
I_IO.Put(Item => Szerokosc, Width => 0);
T_IO.Put(",");
I_IO.Put(Item => Wysokosc, Width => 0);
T_IO.Put_Line(")");
-- Chuj ci w dupę alokujemy sobie tabliice
declare
MacierzPingwiny: Macierz(1 .. Wysokosc, 1 .. Szerokosc);
WektorPingwiny: Wektor(1 .. Wysokosc);
WspolX, WspolY: Integer;
LiczbaRyb: Positive;
begin
T_IO.Put_Line("Start");
ZeroingRows:
for i in Integer range 1 .. Wysokosc loop
ZeroingCols:
for j in Integer range 1 .. Szerokosc loop
MacierzPingwiny(i,j) := 0;
end loop ZeroingCols;
end loop ZeroingRows;
T_IO.Put_Line("Wczytujemy pingwiny");
WczytujPingwiny:
for i in Integer range 1 .. LiczbaPingwinow loop
T_IO.Put_Line("Reading Pingwin");
I_IO.Get(Item => WektorPingwiny(i).x);
I_IO.Get(Item => WektorPingwiny(i).y);
T_IO.Put("Wczytany pingwin: (");
I_IO.Put(Item => WektorPingwiny(i).x, Width => 0);
T_IO.Put(",");
I_IO.Put(Item => WektorPingwiny(i).y, Width => 0);
T_IO.Put_Line(")");
end loop WczytujPingwiny;
T_IO.Put_Line("Wczytujemy kry z rybami");
WczytujKry:
for i in Integer range 1 .. LiczbaKier loop
T_IO.Put_Line("Reading Kra");
I_IO.Get(Item => WspolX);
I_IO.Get(Item => WspolY);
I_IO.Get(Item => LiczbaRyb);
MacierzPingwiny(WspolY,WspolX) := LiczbaRyb;
end loop WczytujKry;
Symuluj(MacierzPingwiny,WektorPingwiny);
end;
null;
end pingwiny;

29
2015/2015_03/ada/sigint_handler.adb Normal file
View File

@ -0,0 +1,29 @@
package body Sigint_Handler is
-------------
-- Handler --
-------------
protected body Handler is
----------
-- Wait --
----------
entry Wait when Call_Count > 0 is
begin
Call_Count := Call_Count - 1;
end Wait;
------------
-- Handle --
------------
procedure Handle is
begin
Call_Count := Call_Count + 1;
end Handle;
end Handler;
end Sigint_Handler;

14
2015/2015_03/ada/sigint_handler.ads Normal file
View File

@ -0,0 +1,14 @@
with Ada.Interrupts; use Ada.Interrupts;
with Ada.Interrupts.Names; use Ada.Interrupts.Names;
package Sigint_Handler is
pragma Unreserve_All_Interrupts;
protected Handler is
entry Wait;
procedure Handle;
pragma Attach_Handler (Handle, Ada.Interrupts.Names.SIGINT);
private
Call_Count : Natural := 0;
end Handler;
end Sigint_Handler;

39
2015/2015_03/ada/signals.adb Normal file
View File

@ -0,0 +1,39 @@
with Ada.Calendar; use Ada.Calendar;
with Ada.Text_Io; use Ada.Text_Io;
with Sigint_Handler; use Sigint_Handler;
procedure Signals is
task Counter is
entry Stop;
end Counter;
task body Counter is
Current_Count : Natural := 0;
begin
loop
select
accept Stop;
exit;
or delay 0.5;
end select;
Current_Count := Current_Count + 1;
Put_Line(Natural'Image(Current_Count));
end loop;
end Counter;
task Sig_Handler;
task body Sig_Handler is
Start_Time : Time := Clock;
Sig_Time : Time;
begin
Put_Line("Sig_Handler start");
Handler.Wait;
Sig_Time := Clock;
Counter.Stop;
Put_Line("Program execution took" & Duration'Image(Sig_Time - Start_Time) & " seconds");
end Sig_Handler;
begin
Put_Line("Program start");
null;
end Signals;

9
2015/2015_03/ada/sorting/objects/czlowiek-bialy.adb Normal file
View File

@ -0,0 +1,9 @@
package body czlowiek.bialy is
procedure bialy(This: in out obj_czlowiek) is begin
This.prot.v2 := 2;
-- This.p.v3 := 4; -- błąd dziwny
czlowiek.init(czlowiek.obj(This),3);
end bialy;
end czlowiek.bialy;

9
2015/2015_03/ada/sorting/objects/czlowiek-bialy.ads Normal file
View File

@ -0,0 +1,9 @@
package czlowiek.bialy is
type obj_czlowiek is new obj with record
v4: Integer;
end record;
procedure bialy (This: in out obj_czlowiek);
end czlowiek.bialy;

26
2015/2015_03/ada/sorting/objects/czlowiek.adb Normal file
View File

@ -0,0 +1,26 @@
with Ada.Text_IO;
package body czlowiek is
package T_IO renames Ada.Text_IO;
type obj_private is record
v3: Integer;
end record;
procedure proc_private(This: obj) is begin
T_IO.Put_Line("Private");
end proc_private;
procedure init(This: in out obj; val: Integer) is
begin
This.p := new obj_private;
This.p.v3 := 3;
czlowiek.proc_private(This);
end init;
procedure proc_protected(This: obj) is begin
null;
end proc_protected;
end czlowiek;

28
2015/2015_03/ada/sorting/objects/czlowiek.ads Normal file
View File

@ -0,0 +1,28 @@
with Ada.Finalization;
package czlowiek is
type obj_public is tagged record
v1: Integer;
end record;
type obj is new obj_public with private;
procedure init(This: in out obj; val: Integer);
private
type obj_private;
type obj_private_ptr is access obj_private;
type obj_protected is new Ada.Finalization.Controlled with record
v2: Integer;
end record;
type obj is new obj_public with record
prot: obj_protected;
p: obj_private_ptr;
end record;
procedure proc_protected(This: obj);
end czlowiek;

3
2015/2015_03/ada/sorting/objects/czlowieka.ads Normal file
View File

@ -0,0 +1,3 @@
package czlowiek is
end czlowiek;

17
2015/2015_03/ada/sorting/objects/objects.adb Normal file
View File

@ -0,0 +1,17 @@
with czlowiek;
with czlowiek.bialy;
procedure objects is
os1: czlowiek.obj;
os2: czlowiek.bialy.obj_czlowiek;
begin
os1.v1 := 1;
-- os1.p.v3 := 2; -- nie ma dostępu
-- czlowiek.proc_protected(os1); -- nie ma dostępu
os2.v1 := 2;
-- os2.prot.v2 := 3;
czlowiek.init(os1,3);
czlowiek.bialy.bialy(os2);
end objects;

185
2015/2015_03/ada/sorting/select/pl-tpolgrabia-sorting.adb Normal file
View File

@ -0,0 +1,185 @@
with Ada.Text_IO;
with Ada.Integer_Text_IO;
with Ada.Numerics.Discrete_Random;
package body Pl.Tpolgrabia.Sorting is
function isSorted(arr: ElementArr) return Boolean is
begin
CheckSortedLoop:
for i in Integer range arr'First .. arr'Last loop
if arr(i) > arr(i-1) then
return false;
end if;
end loop CheckSortedLoop;
return true;
end isSorted;
procedure SelectSort(arr: in out ElementArr) is
temp: Element;
maxIdx: Integer;
begin
ILoop:
for i in arr'Range loop
maxIdx := i;
JLoop:
for j in Integer range i+1 .. arr'Last loop
if arr(j) < arr(maxIdx) then
maxIdx := j;
end if;
end loop JLoop;
temp := arr(i);
arr(i) := arr(maxIdx);
arr(maxIdx) := temp;
end loop ILoop;
end SelectSort;
procedure InsertionSort(arr: in out ElementArr)
is
temp: Element;
left, right, currIdx, placeToInsert: Integer;
begin
ILoop:
for i in arr'First + 1 .. arr'Last loop
if arr(i-1) > arr(i) then
left := arr'First;
right := i - 1;
JBinarySearchLoop:
while left < right loop
currIdx := (left + right) / 2;
if arr(currIdx) < arr(i) then
left := currIdx+1;
if left > right then
left := right;
end if;
elsif arr(currIdx) = arr(i) then
left := currIdx;
right := currIdx;
else
right := currIdx-1;
if right < left then
right := left;
end if;
end if;
end loop JBinarySearchLoop;
-- right to idx, gdzie mamy wstawic element z i
temp := arr(i);
placeToInsert := right;
if (arr(right) < temp) then
placeToInsert := right + 1;
else
placeToInsert := right;
end if;
for j in reverse Integer range placeToInsert .. i - 1 loop
arr(j+1) := arr(j); -- przesuwamy o 1 w prawo
end loop;
arr(placeToInsert) := temp;
end if;
end loop ILoop;
end InsertionSort;
procedure BubbleSort(arr: in out ElementArr) is
temp: Element;
begin
ILoop:
for i in reverse Integer range arr'First .. arr'Last - 1 loop
JLoop:
for j in Integer range arr'First .. i loop
if arr(j) > arr(j+1) then
temp := arr(j);
arr(j) := arr(j+1);
arr(j+1) := temp;
end if;
end loop JLoop;
end loop ILoop;
end BubbleSort;
procedure QuickSortPart(arr: in out ElementArr; from, to: Integer) is
pivot,temp: Element;
pivotIdx: Integer;
i,j: Integer;
begin
if from >= to then
return;
end if;
pivotIdx := (from+to) / 2;
pivot := arr(pivotIdx);
i := from;
j := to;
PartitionLoop:
while i < j loop
SearchForGreaterThanPivotLoop:
while i < j and arr(i) < pivot loop
i := i + 1;
end loop SearchForGreaterThanPivotLoop;
SearchForLesserThanPivotLoop:
while i < j and arr(j) >= pivot loop
j := j - 1;
end loop SearchForLesserThanPivotLoop;
if i < j and arr(i) >= pivot and arr(j) < pivot then
if arr(i) = pivot then
pivotIdx := j;
end if;
temp := arr(i);
arr(i) := arr(j);
arr(j) := temp;
i := i + 1;
j := j - 1;
end if;
end loop PartitionLoop;
if arr(i) < pivot then
i := i + 1;
end if;
arr(pivotIdx) := arr(i);
arr(i) := pivot;
-- spartycjonowano
QuickSortPart(arr, from, i-1);
QuickSortPart(arr, i+1, to);
null;
end QuickSortPart;
procedure QuickSort(arr: in out ElementArr) is
-- temp: Element;
begin
QuickSortPart(arr, arr'First, arr'Last);
-- temp := arr(arr'First);
-- arr(arr'First) := arr(arr'Last);
-- arr(arr'Last) := temp;
end QuickSort;
end Pl.Tpolgrabia.Sorting;

21
2015/2015_03/ada/sorting/select/pl-tpolgrabia-sorting.ads Normal file
View File

@ -0,0 +1,21 @@
generic
type Element is private;
type ElementArr is array (Positive range <>) of Element;
with function "<" (X,Y: Element) return Boolean is <>;
with function ">" (X,Y: Element) return Boolean is <>;
with function ">=" (X,Y: Element) return Boolean is <>;
package Pl.Tpolgrabia.Sorting is
procedure SelectSort(arr: in out ElementArr) with
Post => isSorted(arr);
procedure InsertionSort(arr: in out ElementArr) with
Post => isSorted(arr);
procedure BubbleSort(arr: in out ElementArr) with
Post => isSorted(arr);
procedure QuickSort(arr: in out ElementArr) with
Post => isSorted(arr);
function isSorted(arr: ElementArr) return boolean;
end Pl.Tpolgrabia.Sorting;

3
2015/2015_03/ada/sorting/select/pl-tpolgrabia.ads Normal file
View File

@ -0,0 +1,3 @@
package Pl.Tpolgrabia is
end Pl.Tpolgrabia;

3
2015/2015_03/ada/sorting/select/pl.ads Normal file
View File

@ -0,0 +1,3 @@
package Pl is
end Pl;

63
2015/2015_03/ada/sorting/select/selectsort.adb Normal file
View File

@ -0,0 +1,63 @@
with Ada.Text_IO;
with Ada.Integer_Text_IO;
with Ada.Numerics.Discrete_Random;
with Pl.Tpolgrabia.Sorting;
procedure SelectSort is
subtype RandRange is Integer'Base range 0 .. 256;
type IntegerArray is array (Positive range <>) of Integer;
package RandInteger is new Ada.Numerics.Discrete_Random(RandRange);
package T_IO renames Ada.Text_IO;
package I_IO renames Ada.Integer_Text_IO;
tab: IntegerArray(1 .. 16);
seed: RandInteger.Generator;
-- procedure IntSelectSort is new Pl.Tpolgrabia.Sorting.SelectSort (
-- Element => Integer,
-- ElementArr => IntegerArray
-- );
package IntegerSorting is new Pl.Tpolgrabia.Sorting (
Element => Integer,
ElementArr => IntegerArray
);
begin
RandInteger.Reset(seed);
RandFill:
for idx in tab'Range loop
tab(idx) := RandInteger.Random(seed);
T_IO.Put("Element to: ");
I_IO.Put(Item => tab(idx), Width => 1);
T_IO.New_Line;
end loop RandFill;
T_IO.Put_Line("End of display");
T_IO.New_Line;
-- IntSelectSort(tab);
-- IntegerSorting.SelectSort(tab);
-- IntegerSorting.InsertionSort(tab);
-- IntegerSorting.BubbleSort(tab);
IntegerSorting.QuickSort(tab);
DisplayLoop:
for idx in tab'Range loop
T_IO.Put("Element to: ");
I_IO.Put(Item => tab(idx), Width => 1);
T_IO.New_Line;
end loop DisplayLoop;
T_IO.Put_Line("End of display");
T_IO.New_Line;
end SelectSort;