|
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 - 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