with Ada.Unchecked_Deallocation; with Ada_Store.Trading.Transaction.Sale; with Ada_Store.User; package Ada_Store.PoST.Application.Sequences is -- -- start state driver. -- procedure Start; private type Sale_Ptr is access Trading.Transaction.Sale.Instance; procedure Free is new Ada.Unchecked_Deallocation(Trading.Transaction.Sale.Instance, Sale_Ptr); type State_Proc is access procedure; procedure Wait_For_User; procedure Main_Trading_Loop; procedure Basket_Loop; procedure Tendering_Loop; Next_State : State_Proc := Wait_For_User'Access; Current_Sale : Sale_Ptr := null; Current_User : User.Instance; end Ada_Store.PoST.Application.Sequences;
with Ada_Store.PoST.Input_Queue; use Ada_Store.PoST.Input_Queue; with Ada_Store.PoST.Application.Operations; with Ada_Store.Support.Trace; package body Ada_Store.PoST.Application.Sequences is -- internal Transaction_Change : Currency; -- public procedure Start is Log_Element_1 : Application_Log(Start_Up); Log_Element_2 : Application_Log(Close_Down); begin Ada_Store.Log.Open_Log; Ada_Store.Log.Put(Ada_Store.Log.Element'Class(Log_Element_1)); Operations.Initialise; while Next_State /= null loop begin Next_State.all; exception when others => Operations.Error("EXCEPTION"); Next_State := Wait_For_User'Access; end; end loop; Operations.Finalise; Ada_Store.Log.Put(Ada_Store.Log.Element'Class(Log_Element_2)); end Start; -- private procedure Wait_For_User is Inp_Msg : Input_Queue.Message_Ptr; Allowed : Operations.Input_Allowed := (1 => Sign_On); begin Operations.Display_Welcome; loop Inp_Msg := Operations.Get_Input(Allowed, True, "USER ID"); begin Operations.User_Sign_On(Current_User, Inp_Msg.Input(1 .. Inp_Msg.Length)); Next_State := Main_Trading_Loop'Access; exit; exception when User.Invalid_Identifier => null; end ; end loop; end Wait_For_User; procedure Main_Trading_Loop is Inp_Msg : Input_Queue.Message_Ptr; Allowed : Operations.Input_Allowed := (Item_Sale, Department_Sale, Price_Enquiry, Sign_Off, Close_Down); begin Current_Sale := new Trading.Transaction.Sale.Instance; Operations.Transaction_New(Current_Sale.all); Transaction_Change := 0.00; loop Inp_Msg := Operations.Get_Input(Allowed); case Inp_Msg.Action is when Item_Sale => Operations.Transaction_Item(Current_Sale.all, Inp_Msg.Input(1 .. Inp_Msg.Length)); Next_State := Basket_Loop'Access; exit; when Department_Sale => Operations.Transaction_Department(Current_Sale.all, Inp_Msg.Input(1 .. Inp_Msg.Length)); Next_State := Basket_Loop'Access; exit; when Price_Enquiry => Operations.Price_Enquiry(Inp_Msg.Input(1 .. Inp_Msg.Length)); when Sign_Off => Operations.User_Sign_Off(Current_User); Next_State := Wait_For_User'Access; exit; when Close_Down => Next_State := null; exit; when others => Operations.Error("INVALID INPUT"); end case; end loop; end Main_Trading_Loop; procedure Basket_Loop is Inp_Msg : Input_Queue.Message_Ptr; Allowed : Operations.Input_Allowed := (Item_Sale, Department_Sale, Price_Enquiry, Sub_Total, Cancel); Void_Input : Operations.Input_Allowed := (Enter, Cancel); begin loop Inp_Msg := Operations.Get_Input(Allowed); case Inp_Msg.Action is when Item_Sale => Operations.Transaction_Item(Current_Sale.all, Inp_Msg.Input(1 .. Inp_Msg.Length)); when Department_Sale => Operations.Transaction_Department(Current_Sale.all, Inp_Msg.Input(1 .. Inp_Msg.Length)); when Price_Enquiry => Operations.Price_Enquiry(Inp_Msg.Input(1 .. Inp_Msg.Length)); when Sub_Total => Operations.Transaction_SubTotal(Current_Sale.all); Next_State := Tendering_Loop'Access; exit; when Cancel => Inp_Msg := Operations.Get_Input(Void_Input, False, "ACCEPT TO VOID SALE"); if Inp_Msg.Action = Enter then Operations.Transaction_Void(Current_Sale.all); Free(Current_Sale); Next_State := Main_Trading_Loop'Access; exit; end if; when others => Operations.Error("INVALID INPUT"); end case; end loop; end Basket_Loop; procedure Tendering_Loop is Inp_Msg : Input_Queue.Message_Ptr; Allowed : Operations.Input_Allowed := (Cash_Payment, Cheque_Payment, Card_Payment, Cancel); Transaction_Complete : Boolean; begin loop Inp_Msg := Operations.Get_Input(Allowed, True); case Inp_Msg.Action is when Cash_Payment | Cheque_Payment | Card_Payment => Operations.Transaction_Pay(Current_Sale.all, Inp_Msg.Input(1 .. Inp_Msg.Length), Inp_Msg.Action, Transaction_Complete); if Transaction_Complete then Operations.Transaction_Complete(Current_Sale.all); Free(Current_Sale); Next_State := Main_Trading_Loop'Access; exit; end if; when Cancel => Next_State := Basket_Loop'Access; exit; when others => Operations.Error("INVALID INPUT"); end case; end loop; end Tendering_Loop; end Ada_Store.PoST.Application.Sequences;
Copyright ©
1996 Simon Johnston &
Addison Wesley Longman