with Audit_Instrum; with Text_IO; use Text_IO; with ONEARMEDBANDIT; use ONEARMEDBANDIT; package body ONEARMEDBANDIT is Adt_Dummy_1: Boolean := Audit_Instrum.Audit_Start_Func(1, 0); RESULT: BILLBOARD := (COIN, BELL, COIN, HORSESHOE); --** HAS_JUST_WON: BOOLEAN := false; --** JACK_POT: BILLBOARD := (SEVEN, HORSESHOE, THIRTEEN --** , FOUR_LEAVES_CLOVER); --** NUMBER: WHEEL_NUMBER := 1; --** COMMAND: array (WHEEL_NUMBER) of WHEEL_NUMBER := (1, 2, 3, 4); --** package ACCOUNT_IO is new INTEGER_IO(NUM => ACCOUNT); --** package WHEEL_IO is new INTEGER_IO(NUM => WHEEL_NUMBER); --** package FIGURES_IO is new ENUMERATION_IO(ENUM => FIGURES); package body ALEA is -- *************************************************************** -- Implementation of the random draw. -- The "PERMANENT" task is activated at once -- in parallel with the procedure that imports the -- current "ALEA" package. -- The "PERMANENT" task simply increases simplement a counter -- and suggests the use of a "STOP" switch. -- When using the "STOP" switch thanks to the "RANDOM" function -- it displays the current value of the counter. -- *************************************************************** task PERMANENT is entry STOP (RETVAL: out NATURAL); end PERMANENT; task body PERMANENT is Adt_Dummy_2: Boolean := Audit_Instrum.Audit_Start_Func(2, 0); COUNTER: NATURAL := NATURAL'first; begin loop if COUNTER = NATURAL'last then Audit_Instrum.Audit_Set_Branch(2, 1); COUNTER := NATURAL'first; else Audit_Instrum.Audit_Set_Branch(2, 2); COUNTER := COUNTER + 1; end if; select accept STOP(RETVAL: out NATURAL) do Audit_Instrum.Audit_Set_Branch(2, 3); RETVAL := COUNTER; end STOP; or Audit_Instrum.Audit_Set_Branch(2, 4); terminate; end select; end loop; end PERMANENT; function RANDOM (MIN: in INTEGER := 0; MAX: in INTEGER := 1000) return INTEGER is Adt_Dummy_3: Boolean := Audit_Instrum.Audit_Start_Func(5, 0); DYNAMIC: INTEGER := MAX - MIN + 1; RANDOM: INTEGER; begin Audit_Instrum.Audit_Set_Call(5, 3); PERMANENT.STOP(RANDOM); return MIN + (RANDOM mod DYNAMIC); end; end ALEA; task type WHEEL is --** entry THROW (NUM: in WHEEL_NUMBER; FIGURE: out FIGURES); end WHEEL; --** task body WHEEL is Adt_Dummy_4: Boolean := Audit_Instrum.Audit_Start_Func(7, 0); --** begin --** accept THROW (NUM: in WHEEL_NUMBER --** ; FIGURE: out FIGURES) --** do Audit_Instrum.Audit_Set_Call(8, 5); FIGURE := FIGURES'val(ALEA.RANDOM(0, 7)); --** end THROW; end --** WHEEL; --** procedure DISPLAY (RESULT: in BILLBOARD) is Adt_Dummy_5: Boolean := Audit_Instrum.Audit_Start_Func(10, 0); begin -- ************************************************************ -- This procedure displays the four pictures contained -- in the global array variable "RESULT" -- ************************************************************ declare Audit_Flag_Loop: Boolean := False; begin for WHEEL in WHEEL_NUMBER loop Audit_Flag_Loop := True; Audit_Instrum.Audit_Set_Branch(10, 2); Audit_Instrum.Audit_Set_Call(10, 28); FIGURES_IO.PUT(RESULT(WHEEL)); Audit_Instrum.Audit_Set_Call(10, 28); PUT(" "); Audit_Flag_Loop := False; end loop; if not Audit_Flag_Loop then Audit_Instrum.Audit_Set_Branch(10, 1); end if; end; Audit_Instrum.Audit_Set_Call(10, 29); NEW_LINE; end; function THREE_OF_A_KIND return BOOLEAN is Adt_Dummy_6: Boolean := Audit_Instrum.Audit_Start_Func(12, 6); begin -- ************************************************************ -- This function returns the value TRUE if the result -- of the game is a trhee of a kind -- otherwise it reurn FALSE -- If A,B,C et D are the 4 obtained pictures -- we have a three of a kind if (with a exclusive or#) -- ((A = B) and (A = C or# A = D)) or ((C = D) and (C = A or# C = B)) -- ************************************************************ return (Audit_Instrum.Audit_Set_Mcdc (12, 1, 6, ((Audit_Instrum.Audit_Set_Sgl_Cond(12, 1, 1, RESULT(1) = RESULT(2))) and ((Audit_Instrum.Audit_Set_Sgl_Cond(12, 1, 2, RESULT(1) = RESULT(4))) xor (Audit_Instrum.Audit_Set_Sgl_Cond (12, 1, 3, RESULT(1) = RESULT(3))))) or ((Audit_Instrum.Audit_Set_Sgl_Cond(12, 1, 4, RESULT(3) = RESULT(4))) and ((Audit_Instrum.Audit_Set_Sgl_Cond(12, 1, 5, RESULT(3) = RESULT(1))) xor (Audit_Instrum.Audit_Set_Sgl_Cond (12, 1, 6, RESULT(3) = RESULT(2))))))); end; function SQUARE return BOOLEAN is Adt_Dummy_7: Boolean := Audit_Instrum.Audit_Start_Func(14, 2); -- ************************************************************ -- This function returns TRUE if the result of the game is -- a square (4 pictures out of 4 alike) -- otherwise it returns FALSE -- ************************************************************ RETVAL: BOOLEAN := TRUE; begin declare Audit_Flag_Loop: Boolean := False; begin for WHEEL in 2 .. WHEEL_NUMBER'last loop Audit_Flag_Loop := True; Audit_Instrum.Audit_Set_Branch(14, 2); RETVAL := Audit_Instrum.Audit_Set_Mcdc (14, 1, 2, Audit_Instrum.Audit_Set_Sgl_Cond(14, 1, 1, RETVAL) and (Audit_Instrum.Audit_Set_Sgl_Cond (14, 1, 2, RESULT(WHEEL) = RESULT(1)))); Audit_Flag_Loop := False; end loop; if not Audit_Flag_Loop then Audit_Instrum.Audit_Set_Branch (14, 1); end if; end; return RETVAL; end; procedure WON (ABET: in out ACCOUNT; FORTUNE: in out ACCOUNT) is Adt_Dummy_8: Boolean := Audit_Instrum.Audit_Start_Func(16, 0); -- ************************************************************ -- This procedure manges and edits the money the player wins -- by using the following rule: -- the JACK_POT brings 10 times the bet -- the SQUARE brings 5 times the bet -- the THREE_OF_A_KIND brings 2 times the bet -- It then activates the 4 wheels -- the player starts again with a random result -- (This draw enables to win money but not to lose -- ************************************************************ GAIN: ACCOUNT := 0; begin HAS_JUST_WON := TRUE; Audit_Instrum.Audit_Set_Call(16, 14); if RESULT = JACK_POT then Audit_Instrum.Audit_Set_Branch(16, 1); GAIN := 10 * ABET; elsif SQUARE then Audit_Instrum.Audit_Set_Branch(16, 2); GAIN := 5 * ABET; else Audit_Instrum.Audit_Set_Branch(16, 3); GAIN := 2 * ABET; end if; FORTUNE := FORTUNE + GAIN; Audit_Instrum.Audit_Set_Call(16, 28); PUT("You have won "); Audit_Instrum.Audit_Set_Call(16, 30); ACCOUNT_IO.PUT(GAIN); Audit_Instrum.Audit_Set_Call(16, 29); NEW_LINE; Audit_Instrum.Audit_Set_Call(16, 28); PUT("Your fortune comes to a total of "); Audit_Instrum.Audit_Set_Call(16, 30); ACCOUNT_IO.PUT(FORTUNE); Audit_Instrum.Audit_Set_Call(16, 29); NEW_LINE; Audit_Instrum.Audit_Set_Call(16, 28); PUT("Automatic draw "); Audit_Instrum.Audit_Set_Call(16, 29); NEW_LINE; NUMBER := 4; -- automatic COMMAND := (1, 2, 3, 4); -- draw Audit_Instrum.Audit_Set_Call(16, 18); PLAY(ABET, FORTUNE); end -- of the 4 wheels ; procedure PLAY (ABET: in out ACCOUNT; FORTUNE: in out ACCOUNT) is Adt_Dummy_9: Boolean := Audit_Instrum.Audit_Start_Func(18, 3); -- ************************************************************ -- This procedure activates the n wheels required -- (n is given in the gloabl variable "NUMBER", -- The n wheels chosen by the player are in -- the global array variable "COMMAND". -- It then displays the final result, -- analyzes this result and manages the gains and the loses. -- ************************************************************ type RANG is access WHEEL; POINTED: array (WHEEL_NUMBER) of RANG := (others => null); CUR_FIGURE: FIGURES := BELL; begin declare Audit_Flag_Loop: Boolean := False; begin for NO_WHEEL in 1 .. NUMBER loop Audit_Flag_Loop := True; Audit_Instrum.Audit_Set_Branch (18, 2); --* POINTED (NO_WHEEL) := new WHEEL; --* Elaboration de n tasks Audit_Flag_Loop := False; end loop; --* (by pointer) if not Audit_Flag_Loop then Audit_Instrum.Audit_Set_Branch (18, 1); end if; end; declare Audit_Flag_Loop: Boolean := False; begin --* for NO_WHEEL in 1 .. NUMBER loop Audit_Flag_Loop := True; Audit_Instrum.Audit_Set_Branch (18, 4); Audit_Instrum.Audit_Set_Call (18, 8); -- activation of n tasks in parallel POINTED(NO_WHEEL).THROW(COMMAND(NO_WHEEL), CUR_FIGURE); RESULT (COMMAND(NO_WHEEL)) := CUR_FIGURE; Audit_Flag_Loop := False; end loop; if not Audit_Flag_Loop then Audit_Instrum.Audit_Set_Branch (18, 3); end if; end; Audit_Instrum.Audit_Set_Call(18, 10); DISPLAY(RESULT); Audit_Instrum.Audit_Set_Call(18, 14); Audit_Instrum.Audit_Set_Call(18, 12); if Audit_Instrum.Audit_Set_Mcdc (18, 1, 3, Audit_Instrum.Audit_Set_Sgl_Cond(18, 1, 1, RESULT = JACK_POT) or Audit_Instrum.Audit_Set_Sgl_Cond(18, 1, 2, SQUARE) or Audit_Instrum.Audit_Set_Sgl_Cond (18, 1, 3, THREE_OF_A_KIND)) then Audit_Instrum.Audit_Set_Branch (18, 5); Audit_Instrum.Audit_Set_Call (18, 16); WON (ABET, FORTUNE); else Audit_Instrum.Audit_Set_Branch (18, 6); Audit_Instrum.Audit_Set_Call (18, 22); LOST (ABET, FORTUNE); end if; Audit_Instrum.Audit_Set_Call(18, 29); NEW_LINE; end; procedure BET (FORTUNE: in out ACCOUNT; ABET: in out ACCOUNT) is Adt_Dummy_10: Boolean := Audit_Instrum.Audit_Start_Func(20, 0); begin -- ******************************************** -- This procedure enables the player to enter -- how much money he wants to bet on the draw -- and how many wheels (and which ones) -- this draw will be used -- ******************************************** Audit_Instrum.Audit_Set_Call(20, 28); PUT("Your fortune comes to a total of : "); Audit_Instrum.Audit_Set_Call(20, 30); ACCOUNT_IO.PUT(FORTUNE); Audit_Instrum.Audit_Set_Call(20, 29); NEW_LINE; Audit_Instrum.Audit_Set_Call(20, 28); PUT("How much do you want to bet ? "); Audit_Instrum.Audit_Set_Call(20, 29); NEW_LINE; Audit_Instrum.Audit_Set_Call(20, 31); ACCOUNT_IO.GET(ABET); Audit_Instrum.Audit_Set_Call(20, 29); NEW_LINE; if ABET > FORTUNE then Audit_Instrum.Audit_Set_Branch(20, 1); ABET := FORTUNE; Audit_Instrum.Audit_Set_Call(20, 28); PUT("Bet depending on your credit, this is to say "); Audit_Instrum.Audit_Set_Call(20, 30); ACCOUNT_IO.PUT(ABET); Audit_Instrum.Audit_Set_Call(20, 29); NEW_LINE; else Audit_Instrum.Audit_Set_Branch(20, 2); end if; if ABET > 0 then Audit_Instrum.Audit_Set_Branch(20, 3); Audit_Instrum.Audit_Set_Call(20, 28); PUT ("How many wheels do you wish to use ? (only 1 to 4 is allowed)"); Audit_Instrum.Audit_Set_Call(20, 29); NEW_LINE; Audit_Instrum.Audit_Set_Call(20, 32); WHEEL_IO.GET(NUMBER); Audit_Instrum.Audit_Set_Call(20, 29); NEW_LINE; if NUMBER = 4 then Audit_Instrum.Audit_Set_Branch(20, 4); COMMAND := (1, 2, 3, 4); Audit_Instrum.Audit_Set_Call(20, 29); NEW_LINE; else Audit_Instrum.Audit_Set_Branch(20, 5); declare Audit_Flag_Loop: Boolean := False; begin for INDEX in 1 .. NUMBER loop Audit_Flag_Loop := True; Audit_Instrum.Audit_Set_Branch(20, 7); Audit_Instrum.Audit_Set_Call(20, 28); PUT ("Which wheel do you wish to use ? (only 1 to 4 is allowed)"); Audit_Instrum.Audit_Set_Call(20, 29); NEW_LINE; Audit_Instrum.Audit_Set_Call(20, 32); WHEEL_IO.GET(COMMAND(INDEX)); Audit_Flag_Loop := False; end loop; if not Audit_Flag_Loop then Audit_Instrum.Audit_Set_Branch(20, 6); end if; end; end if; else Audit_Instrum.Audit_Set_Branch(20, 8); end if; end; procedure LOST (ABET: in ACCOUNT; FORTUNE: in out ACCOUNT) is Adt_Dummy_11: Boolean := Audit_Instrum.Audit_Start_Func(22, 0); begin -- ********************************************************** -- This procedure manages and edits the losses of the player -- ********************************************************** if HAS_JUST_WON then Audit_Instrum.Audit_Set_Branch(22, 1); HAS_JUST_WON := false; Audit_Instrum.Audit_Set_Call(22, 28); PUT("You have lost "); Audit_Instrum.Audit_Set_Call(22, 29); NEW_LINE; else Audit_Instrum.Audit_Set_Branch(22, 2); FORTUNE := FORTUNE - ABET; Audit_Instrum.Audit_Set_Call(22, 28); PUT("You have lost "); Audit_Instrum.Audit_Set_Call(22, 30); ACCOUNT_IO.PUT(ABET); Audit_Instrum.Audit_Set_Call(22, 29); NEW_LINE; end if; end; end ONEARMEDBANDIT;