-+-+-+-+-+-+-+-+ START OF PART 76 -+-+-+-+-+-+-+-+ X prt(' ------------------------------------------- ',2,11); X prt('`7C `7C _-_ ', 3,11); X prt('`7C `7C / \ ',4,11); X prt('`7C XXXXXXXXXXXXX XXXXXXXXXXXXX XXXXXXXXXXXXX `7C ( ) ',5,11); X prt('`7C X X X X X X `7C \ _ / ',6,11); X prt('`7C X X X X X X `7C `7C `7C ',7, V11); X prt('`7C X X X X X X `7C `7C `7C ',8, V11); X prt('`7C XXXXXXXXXXXXX XXXXXXXXXXXXX XXXXXXXXXXXXX `7C `7C `7C ',09 V,11); X prt('`7C `7C `7C `7C ',10 V,11); X prt('`7C X X X `7C `7C `7C ',11 V,11); X prt('`7C XXX XXX XXX `7C__/ `7C ',12,1 V1); X prt('`7C X X X `7C `7C ',13,1 V1); X prt('`7C `7C____/ ',14,11) V; X prt('`7C `7C ',15,11 V); X prt('`7C `7C ',16,11 V); X prt('`7C `7C ',17,11 V); X prt(' -------------------------------------------',18,11); X`20 X prt('You may:',21,1); X prt(' p) pull lever. d) display prizes.',22,2); X prt('`5EZ) Return to main menu. `5ER) Redraw the screen.',23,2); Xend; X`20 X`20 X(* Centers slots in middle of box *) Xprocedure position_adjust(var c1,c2,c3 : integer); X`20 Xbegin X c1 := 15; X c2 := 29; X c3 := 43; X if (ord(pos`5B1`5D) > 2) then c1 := 14; X if (ord(pos`5B2`5D) > 2) then c2 := 28; X if (ord(pos`5B3`5D) > 2) then c3 := 42; Xend; X`20 X`20 X`20 Xprocedure display_slots; X var X out_val : vtype; X c1,c2,c3 : integer; X`20 Xbegin X clear(1,1); X display_slot_options; X position_adjust(c1,c2,c3); X writev(out_val,pos`5B1`5D); X put_buffer(out_val,7,c1); X writev(out_val,pos`5B2`5D); X put_buffer(out_val,7,c2); X writev(out_val,pos`5B3`5D); X put_buffer(out_val,7,c3); X display_gold; Xend; X`20 X`20 X`20 Xprocedure display_prizes; X var X command : char; X exit : boolean; X`20 Xbegin Xclear(1,1); Xprt(' 1 2 5 10 25 50 ',4 V,1); Xprt('jackpot jackpot jackpot 1000 2000 5000 1000 25000 50000',6 V,1); Xprt(' bar bar bar 30 60 150 300 750 1500',7 V,1); Xprt(' bell bell bell 15 30 75 150 375 750',8 V,1); Xprt(' orange orange orange 8 16 40 80 200 400',9 V,1); Xprt(' cherry cherry cherry 4 8 20 40 100 200',1 V0,1); Xprt(' bell --- bell 4 8 20 40 100 200',1 V1,1); Xprt(' --- bar bar 4 8 20 40 100 200',1 V2,1); Xprt(' --- orange orange 2 4 10 20 50 100',1 V3,1); Xprt(' jackpot --- --- 2 4 10 20 50 100',1 V4,1); Xprt(' cherry cherry --- 1 2 5 10 25 50',1 V5,1); Xprt('`5Bhit any key to continue`5D',22,27); Xexit := get_com('',command); Xdisplay_slots Xend; X`20 X`20 X`20 X`20 Xprocedure get_slots; X`20 Xbegin X case randint(20) of X 20 : pos`5B1`5D := jackpot; X 19,18,17 : pos`5B1`5D := bar; X 16,15,14,13 : pos`5B1`5D := bell; (* Wheel o Vne *) X 12,11,10,9,8 : pos`5B1`5D := orange; X 7,6,5,4,3,2,1 : pos`5B1`5D := cherry; X end; X`20 X case randint(20) of X 20 : pos`5B2`5D := jackpot; X 19,18,17 : pos`5B2`5D := bar; X 16,15,14,13,12,11 : pos`5B2`5D := bell; (* Wheel V two *) X 10,9,8,7 : pos`5B2`5D := orange; X 6,5,4,3,2,1 : pos`5B2`5D := cherry; X end; X`20 X case randint(20) of X 20 : pos`5B3`5D := jackpot; X 19,18,17,16 : pos`5B3`5D := bar; X 15,14,13 : pos`5B3`5D := bell; (* Wheel th Vree *) X 12,11,10,9,8,7 : pos`5B3`5D := orange; X 6,5,4,3,2,1 : pos`5B3`5D := cherry; X end; Xend; X`20 X`20 X(* clears a line of slots *) Xprocedure clearslots(line : integer); Xvar X killpos : vtype; X`20 Xbegin X killpos := ' '; X put_buffer(killpos,line,15); X put_buffer(killpos,line,29); X put_buffer(killpos,line,43); Xend; X`20 X`20 X(* Simulates wheel spinning *) Xprocedure print_slots; X`20 Xvar X i : integer; X c1,c2,c3 : integer; X`20 Xbegin Xget_slots; `7Bget new slots`7D Xfor i := 1 to 9 do X begin X clearslots(7); `7Bclear middle row`7D X position_adjust(c1,c2,c3); `7Bcenter bar and bell`7D X`20 X writev(out_val,pos`5B1`5D); X put_buffer(out_val,8,c1); X writev(out_val,pos`5B2`5D); X put_buffer(out_val,8,c2); `7Bprint bottom`7D X writev(out_val,pos`5B3`5D); X put_buffer(out_val,8,c3); X`20 X get_slots; `7Bget new slots`7D X position_adjust(c1,c2,c3); X`20 X writev(out_val,pos`5B1`5D); X put_buffer(out_val,6,c1); X writev(out_val,pos`5B2`5D); `7Bprint top row`7D X put_buffer(out_val,6,c2); X writev(out_val,pos`5B3`5D); X put_buffer(out_val,6,c3); X`20 X clearslots(6); `7Bclear top row`7D X clearslots(8); `7Bclear bottom row`7D X`20 X writev(out_val,pos`5B1`5D); X put_buffer(out_val,7,c1); X writev(out_val,pos`5B2`5D); `7Bprint middle row`7D X put_buffer(out_val,7,c2); X writev(out_val,pos`5B3`5D); X put_buffer(out_val,7,c3) X`20 X end Xend; X`20 X(* calculates the amount won *) (* Currently, odds slightly favor *) X (* the user. Return of 101% *) Xprocedure winnings; X`20 Xvar X out_val : vtype; X comment,comment1 : vtype; X winning : integer; X`20 Xbegin X comment := 'You have won '; X comment1 := ' gold pieces!'; X winning := 0; X if (pos`5B1`5D=pos`5B2`5D) and (pos`5B1`5D=cherry) then winning := bet; X if (pos`5B1`5D=jackpot) then winning := bet*2; X if (pos`5B2`5D=pos`5B3`5D) and (pos`5B2`5D=orange) then winning := 2*bet; X if (pos`5B1`5D=pos`5B3`5D) and (pos`5B1`5D=bell) then winning := 4*bet; X if (pos`5B2`5D=pos`5B3`5D) and (pos`5B2`5D=bar) then winning := 4*bet; X`20 X if (pos`5B1`5D=pos`5B2`5D) and (pos`5B1`5D=pos`5B3`5D) then X begin X case (pos`5B1`5D) of X jackpot : winning := 1000*bet; X cherry : winning := 4*bet; X orange : winning := 8*bet; X bell : winning := 15*bet; X bar : winning := 30*bet X end; X end; X if (winning = 0) then X begin X case randint(5) of X 1 : msg_print('You lose. '); X 2 : msg_print('Your money pouch feels a little lighter.'); X 3 : msg_print('Rats! Lost again! '); X 4 : msg_print('The casino owner becomes richer. '); X 5 : msg_print('Apparently you don''t know the secret to winning at slot Vs.'); X end X end X else begin X if winning > bet then begin X case randint( 5) of X 1 : msg_print('Hmmm...Maybe this system really works...'); X 2 : msg_print('Maybe you should quit while you''re ahead.' V); X 3 : msg_print('Coins begin to pour out of the machine.'); X 4 : msg_print('You''re not cheating, are you?'); X 5 : msg_print('Be sure to report your winnings!'); X end; X writev(out_val, comment, winning:1, comment1); X msg_print(out_val); X end X else msg_print('You break even.'); X end; X gld := gld + winning Xend; X`20 X`20 X`20 Xprocedure get_slots_bet; X var X comment : vtype; X num : integer; X exit_flag : boolean; X`20 Xbegin X exit_flag := false; X comment := 'Which machine (1 to 10000 gp)? '; X repeat X if get_response(comment, num) then X begin X bet := num; X if (bet>0) and (bet<10001) then exit_flag :=true X else prt('Improper value.',1,1) X end X else X begin X exit_flag := true; X bet := 0 X end; X until (exit_flag); X if bet > gld then X begin X prt('You have not the gold!',1,1); X bet := 0; X end; Xend; X`20 X`20 Xprocedure slot_commands; X var X command : char; X exit_flag : boolean; X`20 Xbegin X bet := 0; X exit_flag := false; X repeat X if get_com('', command) then X begin X case (ord(command)) of X 112 : get_slots_bet; X 18 : display_slots; X 100 : display_prizes; X otherwise prt('Invalid Command.',1,1); X end X end X else exit_flag := true; X if bet > 0 then X begin X gld := gld - bet; X print_slots; X winnings; X bet := 0; X display_gold X end; X check_casino_kickout; X until (exit_flag) Xend; X`20 X (***** slots main *****) X`20 Xprocedure game_slots; X`20 Xbegin X clear(1,1); X pos`5B1`5D := JACKPOT; X pos`5B2`5D := JACKPOT; X pos`5B3`5D := JACKPOT; X display_slots; X prt('You are standing in front of a row of odd looking machines.',1,1) V; X slot_commands; Xend; X`20 X`20 X`20 $ CALL UNPACK SLOTS.INC;1 1042689217 $ create 'f' X X`7B Following are spell procedure/functions`09`09`09-RAK-`09`7D X`7B These routines are commonly used in the scroll, potion, wands, and`09`7D X`7B staves routines, and are occassionly called from other areas.`09`09`7D X`7B Now included are creature spells also...`09`09`09-RAK`09`7D X X`09`7B Creates an area of water on open floor`09`09-Cap'n- `7D X`5Bglobal,psect(misc6$code)`5D function create_water(y,x : integer) : boolea Vn; X`09begin X`09 create_water := true; X`09end; X X`09`7B Makes an area of water into open floor`09`09-Cap'n- `7D X`5Bglobal,psect(misc6$code)`5D function destroy_water(y,x : integer) : boole Van; X`09begin X`09 destroy_water := true; X`09end; X X`09`7B Does a petrify attack on the fool that used the bad item -Capn-`7D X`5Bglobal,psect(misc6$code)`5D function item_petrify : boolean; X`09begin X`09 item_petrify := true; X`09end; X X`5Bglobal,psect(misc6$code)`5D function mon_resists(a_cptr : byteint) : bool Vean; X`09var`20 X`09`09res_chance : integer; X`09`09delta_lev : integer; X`09begin X`09 with m_list`5Ba_cptr`5D do X`09 with c_list`5Bmptr`5D do X`09 begin X`09`09res_chance := mr; X`09`09delta_lev := (py.misc.lev + py.misc.mr); X`09`09if (delta_lev < 0) then delta_lev := 0; X`09`09res_chance := res_chance - (5 * delta_lev); X`09`09if (res_chance < 0) then res_chance := 0; X`09`09if (res_chance >= randint(100)) then X`09`09 begin X`09`09 msg_print('The '+name+' is protected by a mysterious force.'); X`09`09 mon_resists := true; X`09`09 end X`09`09else`20 X`09`09 mon_resists := false; X`09 end; X `09end; X X`5Bglobal,psect(misc6$code)`5D function mon_save(a_cptr,bonus, X`09`09`09`09`09spell_class : integer) : boolean; X`09var res_chance : integer; X`09begin X`09 with m_list`5Ba_cptr`5D do X`09 with c_list`5Bmptr`5D do X`09 begin X`09`09if (uand(%X'1000',cdefense)<>0) then X`09`09 case (spell_class) of X`09`09 c_sc_hold : bonus := bonus + 4; X`09`09 c_sc_mental : bonus := bonus + 20; X`09`09 otherwise ; X`09`09 end; X`09 mon_save := 20+level+randint(level)+5*bonus > X`09`09`09`09randint(80)+randint(py.misc.lev); X`09 end; X`09end; X Xfunction do_stun(a_cptr : byteint; save_bonus,time : integer) : boolean; X`09var held`09: integer; X`09 m_name`09: vtype; X`09begin X`09 do_stun := true; X`09 with m_list`5Ba_cptr`5D do X`09 begin X`09`09find_monster_name(m_name,a_cptr,true); X`09`09if (not mon_resists(a_cptr)) then X`09 `09if (not mon_save(a_cptr,save_bonus,c_sc_hold)) then X`09 `09 begin X`09`09 do_stun := true; X`09`09 msg_print(m_name+' appears stunned!'); X`09 held := stunned + 1 + randint(time); X`09 if (held > 24) then X`09`09 stunned := 24 X`09`09 else X`09`09 stunned := held; X`09 end; X`09 end; X`09end; X X X X X`09`7B Sleep creatures adjacent to player`09`09`09-RAK-`09`7D X`5Bglobal,psect(misc6$code)`5D function sleep_monsters1(y,x : integer) : boo Vlean; X var X`09`09i1,i2`09`09: integer; X begin X`09sleep_monsters1 := false; X`09for i1 := y-1 to y+1 do X`09 for i2 := x-1 to x+1 do X`09 with cave`5Bi1,i2`5D do X`09 if (cptr > 1) then X`09`09with m_list`5Bcptr`5D do X`09`09 with c_list`5Bmptr`5D do X`09`09 if (not mon_resists(cptr)) then X`09`09 begin X`09`09 sleep_monsters1 := true; X`09`09 if (mon_save(cptr,0,c_sc_mental)) then X`09`09`09msg_print('The ' + name + ' is unaffected.') X`09`09 else X`09`09`09begin X`09`09`09 msg_print('The ' + name + ' falls asleep.'); X`09`09`09 csleep := 500; X`09`09`09end; X`09`09 end; X end; X X`09`7B Detect treasure or object on current panel`09-Steven-`7D X`5Bglobal,psect(misc6$code)`5D function detect_item(typ : integer) : boolean V; X var X`09`09i1,i2`09`09: integer; X`09`09show_it`09`09: boolean; X begin X`09detect_item := false; X`09for i1 := panel_row_min to panel_row_max do X`09 for i2 := panel_col_min to panel_col_max do X`09 with cave`5Bi1,i2`5D do X`09 if (tptr > 0) then X`09`09begin X`09`09 if (typ=c_treasure) then +-+-+-+-+-+-+-+- END OF PART 76 +-+-+-+-+-+-+-+-