-- Department and Employee example:
-- Uses pointers for the employees and for the department array
-- Allows dynamically allocating the employee array of the needed size
-- Input:
-- n = number of departments (needs skipline to skip word departments)
-- for each of n departments
-- department name: read entire line
-- k = number of employees in this department (needs skipline)
-- for each of k employees
-- read name(1 .. 20), id, salary
with ada.text_io; use ada.text_io;
with ada.float_text_io; use ada.float_text_io;
with ada.integer_text_io; use ada.integer_text_io;
with ada.strings.fixed; use ada.strings.fixed;
procedure employ7 is
type StringPtr is access String;
type Employee is record
name: StringPtr;
id: string(1 .. 6);
salary: float;
end record;
type Emp_Access is access Employee;
type Emp_Array_T is array(natural range <>) of Emp_Access;
type Emp_Array_Access_T is access Emp_Array_T;
type Department is record
name: StringPtr;
emp_array: Emp_Array_Access_T;
end record;
type Department_Array_T is array(Natural range <>) of Department;
--------------------------------------------------------
-- Give all a raise, accessing the record directly
procedure give_all_raise_v1(raise_amt: Float; emps: Emp_Array_Access_T) is
e: Emp_Access;
begin
for i in reverse emps'range loop
e := emps(i);
e.all.salary := e.all.salary + raise_amt;
end loop;
end give_all_raise_v1;
--------------------------------------------------------
procedure get_depts(depts: in out Department_Array_T) is
emp_count: Natural; -- Number of employees in this department
begin
for i in depts'range loop
dept_loop:
declare
dn: String := trim(get_line, Ada.Strings.Both);
dnp: StringPtr := new String'(dn);
begin
depts(i).name := dnp;
get(emp_count);
depts(i).emp_array := new Emp_Array_t(1 .. emp_count);
for j in 1 .. emp_count loop
skip_line; -- skip rest of line
empl_loop:
declare
en: String := trim(get_line, Ada.Strings.Both);
enp: StringPtr := new String'(en);
begin
depts(i).emp_array(j) := new Employee;
depts(i).emp_array(j).name := enp;
get(depts(i).emp_array(j).id); -- All is implied
get(depts(i).emp_array(j).salary);
end empl_loop;
end loop;
skip_line; -- After last number, must move to next line
end dept_loop;
end loop;
end get_depts;
--------------------------------------------------------
-- Print all employees
procedure put(emps: Emp_Array_Access_T) is
e: Emp_Access;
begin
for i in emps'range loop
e := emps(i);
set_col(6);
put(e.all.id);
put(e.salary, 9, 2, 0); -- .all is implied
put(" " & e.name.all); -- Put for strings
new_line;
end loop;
end put;
--------------------------------------------------------
dept_count: Natural; -- Number of departments
begin
get(dept_count);
skip_line; -- skip word departments
declare
-- Create an array of department's of the correct size
dept_list: Department_Array_T(1 .. dept_count);
begin
get_depts(dept_list);
-- print departments before raises
put_line("Before raises:");
for i in dept_list'range loop
set_col(3);
put_line(dept_list(i).name.all);
put(dept_list(i).emp_array);
new_line;
end loop;
-- Give raises
for i in dept_list'range loop
give_all_raise_v1(1000.0, dept_list(i).emp_array);
end loop;
-- print departments after raises
put_line("After raises:");
for i in dept_list'range loop
set_col(3);
put_line(dept_list(i).name.all);
put(dept_list(i).emp_array);
new_line;
end loop;
end; -- declare
end employ7;