-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X change_flag : boolean; `7B Did they enter a valid entry? `7D X amount_from : integer; `7B Amount before changing. `7D X amount_to : integer; `7B Amount remaining after changing. `7 VD X`09key_in`09`09: char;`09 `7B input character `7D X typ_from,typ_to : integer; `7B Types of money `7D X prompt : string; `7B Prompt used.`7D X X begin X with py.misc do X begin X key_in := chr(get_money_type('Change what coin? ',change_flag,false)); X if change_flag then X`09begin X`09 coin_stuff(key_in,typ_from); X`09 key_in := chr(get_money_type('Change to? ',change_flag,true)); X`09end; X if change_flag then X begin X`09 coin_stuff(key_in,typ_to); X writev(prompt,'Number of coins to change? (1-', X`09`09money`5Btyp_from`5D:1,'), `5EZ to exit : '); X change_flag := get_entry(prompt,amount_from); X end; X if (change_flag) then X`09begin X amount_to := (amount_from * coin$value`5Btyp_from`5D) div X`09`09`09coin$value`5Btyp_to`5D; `7BNO surcharge`7D X`09 if (amount_to = 0) then X`09 msg_print('You don''t have enough to trade for that type of coin!') X`09 else if (amount_to > bank`5Btyp_to`5D) then X`09 msg_print('The bank doesn''t have enough of that kind of coin!') X`09 else if (money`5Btyp_from`5D < amount_from) then X`09 msg_print('You don''t have enough of that coin!') X else if (inven_weight + coin$weight*(amount_to-amount_from) X`09`09 > weight_limit*100) then X msg_print('You can''t carry that much weight.') X`09 else X`09 with py.misc do X`09 begin`09 `20 X`09`09money`5Btyp_from`5D := money`5Btyp_from`5D - amount_from; X`09`09bank`5Btyp_from`5D := bank`5Btyp_from`5D + amount_from; X`09`09money`5Btyp_to`5D := money`5Btyp_to`5D + amount_to; X`09`09bank`5Btyp_to`5D := bank`5Btyp_to`5D - amount_to; X`09`09inven_weight:=inven_weight+coin$weight*(amount_to-amount_from); X`09 msg_print('The money changer hands you your money.'); X`09`09display_money; X`09 end; X end; X end; X end; X X`20 Xprocedure parse_command; X var X command : char; X begin X if get_com( '', command ) then X case command of X ctrl_R : display_store; X 'd' : deposit_money; X 'w' : withdraw_money; X`09 'c' : change_money; X`09 'i' : prt('The insurance shop has gone out of business.',1,1); X`09 'p' : if (wizard1) then X`09`09 safe_deposit(true) X`09`09 else X`09`09 prt('The dwarves are still installing it, sorry.',1,1); X`09 'r' : if (wizard1) then X`09`09 safe_deposit(false) X`09`09 else X`09`09 prt('The dwarves are still installing it, sorry.',1,1); X otherwise prt( 'Invalid Command.', 1, 1 ); X end `7Bcase`7D X else exit_flag := true; X end; `7Bparse_command`7D X`20 Xbegin `7B Main loop of bank `7D X coin$name`5B4`5D:='gold'; coin$name`5B5`5D:='platinum'; coin$name`5B6`5D:= V'mithril'; X exit_flag := false; X tics := 1; X case randint(7) of X 1 : shop_owner := 'Milton Drysdale (tightwad) Bank'; X 2 : shop_owner := 'Mr. Potter (slumlord) Bank'; X 3 : shop_owner := 'Ebeneezer Scrooge (broker) Bank'; X 4 : shop_owner := 'Scrooge McDuck (avian) Bank'; X 5 : shop_owner := 'Andrew Mellon (treasury) Bank'; X 6 : shop_owner := 'Loony Looby (pizza!) Bank'; X 7 : shop_owner := 'Ram the Booger Eater (Nosepicker) Bank'; X end; X display_store; X X repeat X parse_command; X adv_time(false); X tics := tics + 1; X check_kickout_time(tics,2); X until(exit_flag); X draw_cave; Xend; `7Benter_bank`7D X X X X X X $ CALL UNPACK BANK.INC;1 1448358149 $ create 'f' X`09; X`09; Robert Koeneke X`09; September 1, 1984 X`09; MORIA subroutine X`09; Macro function for : X`09; X`09;`09y := bitpos(x) X`09;`09`09Locate first set bit in x and return that position X`09;`09`09in y. X`09;`09`09Clear bit in x. X`09; X`09.title`09BIT_POS`09`09Return location of next bit X`09.ident`09/bit_pos/ X`09.psect misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2 X`09.entry`09bit_pos,`5EM<> X`09ffs`09#0,#32,@4(ap),r0 X`09beql`092$ X`09bbsc`09r0,@4(ap),1$ X1$:`09incl`09r0 X`09ret X2$:`09clrl`09r0 X`09ret X`09.end $ CALL UNPACK BIT_POS.MAR;1 577438945 $ create 'f' X`09integer function bit_pos64( high, low ) X X!----- X! X!`09This is the 64-bit version of bit_pos X! X!----- X X`09integer`09`09bit_pos X`09integer`09`09pos X`09integer`09`09high, low X X`09pos = bit_pos( low ) X`09if( pos.eq.0 ) then X`09`09pos = bit_pos( high ) X`09`09if( pos.ne.0 ) pos = pos + 32 X`09end if X`09bit_pos64 = pos X`09return X X`09end $ CALL UNPACK BIT_POS64.FOR;1 847132346 $ create 'f' Xvar X deal_bust : boolean; X card5_save,card5 : boolean; X dummy,dummyd : drawcard; X dealerh,playerh : hand; X vald,valp,save : integer; X bust_flag,bust_save : boolean; X split_flag,already_split : boolean; X py_index : integer; X hand_start : integer; X win_draw : boolean; X blackjack,blackjack_save : boolean; X pl_stay_flag : boolean; X dl_ace_flag : boolean; X double_flag,double_flag_save : boolean; X`20 X`20 Xprocedure display_bj; X`20 Xbegin X clear(21,1); X display_gold; X prt('You may:',22,2); X prt(' p) place a bet. v) view the rules',23,2); X prt('`5EZ) Exit blackjack. `5ER) Redraw the screen.',2 V4,2); Xend; X`20 X`20 Xprocedure display_bj_game; X`20 Xbegin X clear(21,1); X prt('Your hand: ',5,1); X prt('Dealer''s hand: ',12,1); X display_gold; X prt('You may: ',21,1); X prt(' s) stand. h) hit.',22,2); X prt(' d) double down. /) split.',23,2); X prt('`5ER) Redraw the screen. v) view the rules. ',24,2); Xend; X`20 Xprocedure opening_screen; X (* 1 2 3 4 5 6 * V) Xbegin(*890123456789012345678901234567890123456789012345678901234567890 * V) X prt( '____', 2,45); X prt( '`7CA `7C ____', 3,44); X prt( 'XXX `7C `7C`7C3 `7C ____', 4,19 V); X prt( 'X X X `7C A`7C`7C `7C`7C7 `7C', V 5,19); X prt( 'XXX X XX ---- `7C 3`7C`7C `7C', 6,19 V); X prt( 'X X X X X XXXX ---- `7C 7`7C', 7,19); X prt( 'XXX X XXXX X X X ----', 8,19); X prt( 'XXXX X X X X X X', 9,25); X prt( 'X X X XX X XX', 10,30); X prt( '____ XXXX X X X X X XXXX', 11,13); X prt( '`7CA `7C ____ X X X X XXXX X X X',12,12); X prt( '`7C `7C`7CJ `7C XXXX X X X X X',13,1 V2); X prt( '`7C A`7C`7C `7C X X X XX', 14,1 V2); X prt( '---- `7C J`7C XXXX X X',15,13); X prt( '---- X X',16,19); Xend; X`20 X`20 X`20 Xprocedure display_rules; X`20 Xvar X command : char; X exit : boolean; X`20 Xbegin X clear(1,1); X prt('MORIA BLACKJACK RULES ',2,21); X prt('The object, of course, is to get as close as you can to 21 without',5 V,2); X prt('going over. Aces can count as either one or eleven, while all',6,2); X prt('face cards count as ten. The other cards are worth their face',7,2); X prt('value.',8,2); X prt('Once you have played your hand, the dealer will draw cards until',10, V2); X prt('he has at least 17. However, if his total is 17 and he has an',11,2) V; X prt('ace, he will hit. ',12,2); X prt('Splitting and Doubling:',14,25); X prt('After drawing your first two cards, you have the option of',16,2); X prt('doubling your bet and taking one, and only one more card. ',17,2); X prt('If your first two cards are the same, you may split, in which case',1 V9,2); X prt('you will then play out both hands, each with the same bet as the',20, V2); X prt('original hand. Splitting is only allowed once per hand.',21,2); X prt('`5Bhit any key to continue`5D',24,23); X exit := get_com('',command); X clear(2,1); X prt('A natural pays 3/2 times your bet, unless the dealer also has',3,2) V; X prt('a blackjack, in which case you push. The dealer will not offer ',4,2 V); X prt('you insurance.',5,2); X prt('If you draw five cards, without going over 21, you automatically',7,2 V); X prt('win, regardless of the dealer''s hand.',8,2); X prt('`5Bhit any key to continue`5D',24,23); X exit := get_com('',command); Xend; X`20 X`20 X`20 Xprocedure initialize_hand; X var X i : integer; X`20 Xbegin X for i := 1 to 10 do X begin X dealerh`5Bi`5D := 0; X dummy`5Bi`5D := ' '; X playerh`5Bi`5D := 0; X dummyd`5Bi`5D := ' '; X end; X bust_flag := false; X hand_start := 1; X pl_stay_flag := false; X card5 := false; X blackjack := false; X py_index := 2; X win_draw := false; X already_split := false; X split_flag := false; X double_flag := false; Xend; X`20 X`20 X`20 Xprocedure evaluate_pl_hand; X var X i : integer; X py_ace_flag : boolean; X`20 Xbegin X bust_flag := false; X py_ace_flag := false; X valp := 0; X for i := hand_start to hand_start + 4 do X begin X if (playerh`5Bi`5D > 10) then valp := valp + 10 X else valp := playerh`5Bi`5D + valp; X if (playerh`5Bi`5D = 14) then X begin X valp := valp - 9; X py_ace_flag := true; X end; X end; X if (valp < 12) and (py_ace_flag) then valp := valp + 10; X if (valp > 21) then bust_flag := true; Xend; X`20 X`20 X`20 Xprocedure evaluate_dl_hand(index : integer); X var X i : integer; X`20 Xbegin X deal_bust := false; X dl_ace_flag := false; X vald := 0; X for i := 1 to index do X begin X if (dealerh`5Bi`5D > 10) then vald := vald + 10 X else vald := dealerh`5Bi`5D + vald; X if (dealerh`5Bi`5D = 14) then vald := vald - 9; X if (dealerh`5Bi`5D = 14) and (vald < 12) then X begin X dl_ace_flag := true; X vald := vald + 10 X end; X if (vald > 21) and dl_ace_flag then X begin X vald := vald - 10; X dl_ace_flag := false; X end X end; X if vald > 21 then deal_bust := true; Xend; X`20 X`20 X`20 Xprocedure hand_save; X`20 Xbegin X save := valp; X evaluate_pl_hand; X pl_stay_flag := false; X card5_save:= card5; X card5 := false; X if double_flag then bet := bet div 2; X double_flag_save := double_flag; X double_flag := false; X blackjack_save := blackjack; X blackjack := false; X hand_start := 6; X already_split := true; X py_index := 7; X bust_save := bust_flag; X bust_flag := false; Xend; X`20 X`20 X`20 Xprocedure check_exit(var exit_flag : boolean); X`20 Xbegin X if double_flag then exit_flag := true; X if (valp = 21) and ((py_index = 2) or (py_index = 7)) then begin X exit_flag := true; X blackjack := true; X end; X if pl_stay_flag then exit_flag := true; X if (py_index = 5) or (py_index = 10) then begin X exit_flag := true; X card5 := true; X end; X if bust_flag then exit_flag := true; X if split_flag and (exit_flag) and not(already_split) then X begin X hand_save; X msg_print('Now play the hand on the right.'); X exit_flag := false; X end; Xend; X`20 X`20 Xprocedure get_first_dealc; X var X c : integer; X draw : vtype; X`20 Xbegin X draw := ' ____'; X writev(out_val,draw); X put_buffer(out_val,13,8); X draw := '`7C\ /`7C'; X writev(out_val,draw); X put_buffer(out_val,14,8); X draw := '`7C-**-`7C'; X writev(out_val,draw); X put_buffer(out_val,15,8); X draw := '`7C/ \`7C'; X writev(out_val,draw); X put_buffer(out_val,16,8); X draw := ' ----'; X writev(out_val,draw); X put_buffer(out_val,17,8); Xend; X`20 X`20 Xprocedure card_draw (index,r : integer;card: vtype); X var X c : integer; X draw : vtype; X`20 Xbegin Xif not(card = ' ') then X begin X if ((r = 13) and (index = 1) and (win_draw = false)) then get_first_dealc X else X begin X c := 1 + 7*index; X draw := ' ____'; X writev(out_val,draw); X put_buffer(out_val,r,c); X draw := '`7C `7C'; X writev(out_val,draw); X put_buffer(out_val,r+1,c); X draw := '`7C `7C'; X writev(out_val,draw); X put_buffer(out_val,r+2,c); X draw := '`7C `7C'; X writev(out_val,draw); X put_buffer(out_val,r+3,c); X draw := ' ----'; X writev(out_val,draw); X put_buffer(out_val,r+4,c); X writev(out_val,card); X put_buffer(out_val,r+1,c+1); X if (card = '10') then put_buffer(out_val,r+3,c+3) X else put_buffer(out_val,r+3,c+4) X end X end Xend; X`20 X`20 X`20 Xprocedure re_draw; X var X i : integer; X`20 Xbegin Xclear(1,1); Xprt('Your hand:',5,1); Xprt('Dealer''s hand: ',12,1); Xfor i := 1 to 10 do X begin X card_draw(i,6,dummy`5Bi`5D); X card_draw(i,13,dummyd`5Bi`5D); X end; Xif bet>0 then display_bj_game Xelse display_bj; Xend; X`20 X`20 Xprocedure get_dealer_card(i : integer); X`20 Xbegin X dealerh`5Bi`5D := randint(13)+1; X case (dealerh`5Bi`5D) of X 2 : dummyd`5BI`5D := '2'; X 3 : dummyd`5BI`5D := '3'; X 4 : dummyd`5BI`5D := '4'; X 5 : dummyd`5BI`5D := '5'; X 6 : dummyd`5BI`5D := '6'; X 7 : dummyd`5BI`5D := '7'; X 8 : dummyd`5BI`5D := '8'; X 9 : dummyd`5BI`5D := '9'; X 10 : dummyd`5BI`5D := '10'; X 11 : dummyd`5Bi`5D := 'J'; X 12 : dummyd`5BI`5D := 'Q'; X 13 : dummyd`5BI`5D := 'K'; X 14 : dummyd`5BI`5D := 'A'; X end; +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+-