|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 22528 (0x5800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Expense_Report, seg_0046b8
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Time_Utilities;
with Spreadsheet_Generic;
with Text_Io;
with Io;
with Library;
with Common;
with Editor;
with Calendar;
procedure Expense_Report (Mileage_Rate : String := "1.82"; -- us: 0.0075 ?
Currency_Rate : String := "1.0";
Directory : String := "$";
Load_File : String := "") is
type Col is (Category, Sunday, Monday, Tuesday, Wednesd,
Thursd, Friday, Saturd, A_Total, B_Total);
type Line is (Days, Dates, Mileage, Mil_Allw, Plane, Car_Rent, Loc_Trns,
Lodging, Brkfst, Lunch, Dinner, Biz_Conf, T_Phone, Misc_1,
Misc_2, Totals, Adv_1, Adv_2, Due_Emp, Due_Rational);
package Grid is new Spreadsheet_Generic
(Line, Col, "Expense_Report", "2.0");
package Tools renames Grid.Tool_Set;
function "*" (Width : Natural; C : Character) return String
renames Tools."*";
subtype Week is Col range Sunday .. Saturd;
subtype Items_To_Add is Line range Mil_Allw .. Misc_2;
Mil_Rate : constant Line := Due_Emp;
Cur_Rate : constant Line := Due_Rational;
Param : constant Col := Sunday;
Week_Ending : String (1 .. 5);
type Pos is
record
L : Line;
C : Col;
end record;
type Money is new Float;
A : array (Mileage .. Due_Rational, Sunday .. B_Total) of Money;
Mileage_Reimbursement_Rate : Money renames A (Mil_Rate, Param);
Current_Currency_Rate : Money renames A (Cur_Rate, Param);
type Astring is access String;
Formula : array (Line, Col) of Astring;
package Money_Io is new Text_Io.Float_Io (Money);
package Int_Io is new Text_Io.Integer_Io (Integer);
function Is_Modifiable (L : Line; C : Col) return Boolean is
begin
return ((L in Dates .. Mileage or L in Plane .. Misc_2) and
(C in Week)) or Pos'(L, C) = (Mil_Rate, Param) or
Pos'(L, C) = (Cur_Rate, Param) or
Pos'(L, C) = (Adv_1, A_Total) or Pos'(L, C) = (Adv_2, A_Total);
end Is_Modifiable;
procedure Set (Li : Line; Co : Col; Amount : Money; Aft : Natural := 2) is
begin
A (Li, Co) := Amount;
Grid.Set (Li, Co, Tools.Image
(Float (Amount), Grid.Width (Co), Aft,
Blank_If_Zero => Is_Modifiable (Li, Co)));
end Set;
procedure Compute is
procedure Mileage_Allowance is
Miles : Money := 0.0;
begin
for Day in Week loop
Miles := Miles + A (Mileage, Day);
Set (Mil_Allw, Day,
Money (Mileage_Reimbursement_Rate * A (Mileage, Day)));
if A (Mileage, Day) = 0.0 then
Grid.Set (Mil_Allw, Day, Grid.Width (Day) * ' ');
end if;
end loop;
Set (Mileage, A_Total, Miles);
end Mileage_Allowance;
procedure Total_Line is
Tot : Money := 0.0;
begin
for Day in Week loop
Tot := 0.0;
for Item in Items_To_Add loop
Tot := Tot + A (Item, Day);
end loop;
Set (Totals, Day, Tot);
end loop;
end Total_Line;
procedure A_Col_Total is
Tot, Grand_Tot : Money := 0.0;
begin
for Item in Items_To_Add loop
Tot := 0.0;
for Day in Week loop
Tot := Tot + A (Item, Day);
end loop;
Set (Item, A_Total, Tot);
Grand_Tot := Grand_Tot + Tot;
end loop;
Set (Totals, A_Total, Grand_Tot);
end A_Col_Total;
procedure B_Col_Total is
Tot : Money := 0.0;
begin
for Item in Mil_Allw .. Loc_Trns loop
Set (Item, B_Total, A (Item, A_Total));
end loop;
for Item in Lodging .. Dinner loop
Tot := Tot + A (Item, A_Total);
end loop;
Set (Dinner, B_Total, Tot);
for Item in Biz_Conf .. Misc_2 loop
Set (Item, B_Total, A (Item, A_Total));
end loop;
Set (Totals, B_Total, A (Totals, A_Total));
end B_Col_Total;
procedure Total_Total is
Adv : Money := A (Adv_1, A_Total) + A (Adv_2, A_Total);
Tot : Money renames A (Totals, A_Total);
begin
if Adv < Tot then
Set (Due_Emp, A_Total, Tot - Adv);
Set (Due_Rational, A_Total, 0.0);
else
Set (Due_Rational, A_Total, Adv - Tot);
Set (Due_Emp, A_Total, 0.0);
end if;
end Total_Total;
begin
Mileage_Allowance;
Total_Line;
A_Col_Total;
B_Col_Total;
Total_Total;
end Compute;
function Save_File_Name return String is
File_Name : constant String := "Expenses_Week_Ending_" & Week_Ending;
begin
Library.Context (Directory, Response => "<quiet>");
if Week_Ending = " " then
Tools.Beep ("Date not set up in report");
return Grid.No_File_Name; -- do not get default
else
return File_Name;
end if;
end Save_File_Name;
function Load_File_Name return String is
begin
return Tools.Ask_For ("File to load :");
end Load_File_Name;
procedure Put (L : Line; C : Col; S : String; Valid : out Boolean) is
M, Last : Integer;
Temp, Amount : Money := 0.0;
package Tu renames Time_Utilities;
procedure Date_Input (S : String) is
Date : Tu.Time := (Tu.Value (S));
Now : Tu.Time := Tu.Get_Time;
Cal_Date : Calendar.Time;
Right_Day : Integer;
use Calendar;
begin
-- time_utilities does not take a data such as 5/26
-- it thinks that this is an hour: 5:26 am !!
-- so we have to add the year in front, and recompute Date
if Tu.Image (Date, Tu.Ada, Tu.Short, Tu.Time_Only) /=
Tu.Image (Now, Tu.Ada, Tu.Short, Tu.Time_Only) then
Date := Tu.Value (Tu.Years'Image (Now.Year) & "/" & S);
if Tu.Convert_Time (Now) + (6 * Tu.Day) <
Tu.Convert_Time (Date) then
Date := Tu.Value (Tu.Years'Image (Tu."-" (Now.Year, 1)) &
"/" & S);
Tools.Alert ("I assumed you meant last year :" &
Tu.Image (Date, Contents => Tu.Date_Only) &
". If not, please enter year.", 1);
end if;
end if;
Cal_Date := Tu.Convert_Time (Date);
Right_Day := Integer (Tu.Day_Of_Week (Cal_Date)) mod 7 +
Col'Pos (Sunday);
if Right_Day /= Col'Pos (C) then
Tools.Alert
("Note that " & Tu.Image (Date, Contents => Tu.Date_Only) &
" is a " & Tu.Image (Tu.Day_Of_Week (Date)) & " !", 1);
end if;
for X in Week loop
Date := Tu.Convert_Time (Cal_Date +
(Col'Pos (X) - Right_Day) * Tu.Day);
Grid.Set_And_Show
(Dates, X, " " &
Tu.Image (Date,
Date_Style => Tu.Month_Day_Year,
Contents => Tu.Date_Only) (1 .. 5));
end loop;
-- here Dae contains the date for saturday, last day of the week
-- in the US (Have not they read the Bible over there ?)
Week_Ending :=
Tu.Image (Date, Tu.Ada, Tu.Ada, Tu.Date_Only) (4 .. 8);
end Date_Input;
begin
if L = Dates then
Date_Input (S);
elsif S (1) = '=' and then (L in Mileage .. Misc_2 and
C in Monday .. Saturd) then
Set (L, C, A (L, Col'Pred (C)));
else
Amount := Money (Tools.Float_Value (S));
if C in Week and L in Items_To_Add then
Set (L, C, Amount * Current_Currency_Rate);
if Current_Currency_Rate = 1.0 then
Formula (L, C) := new String'(S);
else
Formula (L, C) := new String'("(" & S & ")*" &
Grid.Get (Cur_Rate, Param));
end if;
else
Formula (L, C) := new String'(S);
if C = Param and then L in Mil_Rate .. Cur_Rate then
Set (L, C, Amount, Aft => 4);
else
Set (L, C, Amount);
end if;
end if;
end if;
Valid := True;
exception
when others =>
Valid := False;
end Put;
function Edit (L : Line; C : Col) return String is
begin
if Formula (L, C) /= null then
return Formula (L, C).all;
else
return Grid.Get (L, C);
end if;
end Edit;
procedure Initialize is
Ok : Boolean;
begin
A := (Mileage .. Due_Rational => (Sunday .. B_Total => 0.0));
Week_Ending := " ";
Grid.Up_And_Left_Border;
for Li in Line range Adv_1 .. Line'Last loop
Grid.Set (Li, B_Total, Tools.Left_Align (' ' & Line'Image (Li),
Grid.Width (B_Total)));
Grid.Set (Li, Col'First, String'
(1 .. Grid.Width (Col'First) => ' '));
end loop;
Grid.Set (Mil_Rate, Col'First, Tools.Left_Align
("Mil Rate", Grid.Width (Col'First)));
Grid.Set (Cur_Rate, Col'First, Tools.Left_Align
("Cur Rate", Grid.Width (Col'First)));
Put (Mil_Rate, Param, Mileage_Rate, Ok);
Put (Cur_Rate, Param, Currency_Rate, Ok);
end Initialize;
function Definition (L : Line; C : Col) return String is
begin
if Formula (L, C) /= null then
Tools.Echo_Line (Formula (L, C).all);
end if;
case L is
when Days =>
return "Move to any item an press 'definition'";
when Dates =>
return
"Enter 1 date in any form: 89/5/22 5-22-89 may 5,1989 ...";
when Mileage =>
return "Miles or kilometers driven for company business";
when Mil_Allw =>
return "Product Mileage * Mileage_Reimbursement_Rate";
when Plane =>
return
"Transportation by plane, train or bus only (what about boat ?)";
when Car_Rent =>
return "Rental car (unless paid directly by Rational)";
when Loc_Trns =>
return
"Local transportation, Taxis, Tolls, Parking, Camels, etc";
when Lodging | Brkfst | Lunch | Dinner =>
return "Meals and lodging. Also includes per diem charge.";
when Biz_Conf =>
return "Good food and entertainment at low cost";
when T_Phone =>
return "Telephone, Telex, Telefax, Pigeon, Smoke signals";
when Misc_1 | Misc_2 =>
return "Any other charge: pens and pencils, aspirin,...";
when Adv_1 | Adv_2 =>
return "Enter amount of any advances from Rational";
when Due_Emp =>
if C in Category .. Sunday then
return "Mileage reimbursement rate (per mile or per km)";
elsif C in A_Total .. B_Total then
return "Amount due to employee by Rational";
else
return "";
end if;
when Due_Rational =>
if C in Category .. Sunday then
return
"Currency exchange rate to MULTIPLY subsequent entries.";
elsif C in A_Total .. B_Total then
return "Amount due to Rational by employee";
else
return "";
end if;
when others =>
return "";
end case;
end Definition;
function Help return String is
function "+" (A, B : String) return String is
begin
return A & Ascii.Lf & B;
end "+";
begin
return --
"Computes an expense report according to Rational rules." +
"Entries can be done with numeric keypad, and can be any" +
" simple arithmetic expression. Spaces or commas are between" +
" numbers are understood as + . Entries are multiplied by" +
" current exchange rate at the time entry is committed." +
"Press [compute] to actually perform computations." +
"Press [save] to save report to a file" +
"Press [load] or give file name as proc. param. to modify" +
" previously saved report" +
"Press [show] to see cells to be filled in";
end Help;
procedure Run is new Grid.Engine (Compute => Compute,
Feed => Put,
Initialize => Initialize,
Column_Width => Grid.All_Columns_Equal,
Home_Position => Grid.Upper_Left_Corner,
Is_Modifiable => Is_Modifiable,
Is_Selected => Is_Modifiable,
Edit_Prompt => Edit,
Definition => Definition,
Command => Grid.Noop,
Help => Help,
Diagnosis => Grid.No_Message,
Save_File_Name => Save_File_Name,
Load_File_Name => Load_File_Name,
Moving_Cursor_Also_Commits => True,
Committing_Also_Computes => False,
Computing_Also_Reformats => True);
begin
Run (Initial_File_To_Load => Load_File);
end Expense_Report;
pragma Main;
nblk1=15
nid=0
hdr6=2a
[0x00] rec0=18 rec1=00 rec2=01 rec3=034
[0x01] rec0=1e rec1=00 rec2=02 rec3=008
[0x02] rec0=00 rec1=00 rec2=11 rec3=038
[0x03] rec0=18 rec1=00 rec2=03 rec3=026
[0x04] rec0=20 rec1=00 rec2=04 rec3=00a
[0x05] rec0=19 rec1=00 rec2=05 rec3=030
[0x06] rec0=20 rec1=00 rec2=06 rec3=02e
[0x07] rec0=00 rec1=00 rec2=15 rec3=014
[0x08] rec0=12 rec1=00 rec2=07 rec3=032
[0x09] rec0=00 rec1=00 rec2=14 rec3=00e
[0x0a] rec0=14 rec1=00 rec2=08 rec3=02c
[0x0b] rec0=00 rec1=00 rec2=13 rec3=002
[0x0c] rec0=16 rec1=00 rec2=09 rec3=01e
[0x0d] rec0=1f rec1=00 rec2=0a rec3=08c
[0x0e] rec0=01 rec1=00 rec2=12 rec3=004
[0x0f] rec0=16 rec1=00 rec2=0b rec3=036
[0x10] rec0=13 rec1=00 rec2=0c rec3=03a
[0x11] rec0=17 rec1=00 rec2=0d rec3=00c
[0x12] rec0=16 rec1=00 rec2=0e rec3=072
[0x13] rec0=0f rec1=00 rec2=0f rec3=06c
[0x14] rec0=07 rec1=00 rec2=10 rec3=000
tail 0x2170029f8815c66eb523a 0x42a00088462061e03