home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / windows / powrdoor / black.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-08-16  |  4.1 KB  |  171 lines
  1. (*----------------------------------------------------------------------*)
  2. (* Program: BlackJack for PowerDOOR by Russell Frey                     *)
  3. (*                                                                      *)
  4. (* Date: August 15, 1991                                                *)
  5. (*                                                                      *)
  6. (* A demonstration of what you can do with PowerDOOR.  It should        *)
  7. (* give you a basic idea of the structure.                              *)
  8. (*----------------------------------------------------------------------*)
  9.  
  10.  
  11. program blackjack;
  12. uses windos,winprocs,strings,powrwin,powrdoor;
  13.  
  14. var
  15.  to_gamble: integer;
  16.  taken_time:integer;
  17.  num_ace:   integer;
  18.  
  19. procedure get_gamble;
  20. var
  21.  temps: string;
  22.  minsleft:integer;
  23.  
  24. begin
  25.  minsleft:= callinfo.minutes_useable-taken_time;
  26.  writeln_com(SENDYELLOW+'You have '+SENDMAGENTA+int_to_asc(minsleft)+
  27.              SENDYELLOW+' minutes left.');
  28.  write_com(SENDCYAN+'How many minutes would you like to bet (9 mins max, 0 to quit)? ');
  29.  ask_user(temps,1);
  30.  to_gamble := asc_to_int(temps);
  31.  if to_gamble > minsleft then to_gamble := 0;
  32.  dec(callinfo.upload_credit,to_gamble);
  33.  inc(taken_time,to_gamble);
  34.  writelncom;
  35. end;
  36.  
  37. function get_card: integer;
  38.  
  39. var
  40.  tempi: integer;
  41.  
  42. begin
  43.  randomize;
  44.  tempi := random(13) + 2;
  45.  case tempi of
  46.   2..10: write_com(int_to_asc(tempi));
  47.   11: begin
  48.        tempi := 10;
  49.        write_com('J');
  50.       end;
  51.   12: begin
  52.        write_com('Q');
  53.        tempi := 10;
  54.       end;
  55.   13: begin
  56.        tempi := 10;
  57.        write_com('K');
  58.       end;
  59.   14: begin
  60.        inc(num_ace);
  61.        write_com('A');
  62.        tempi := 11;
  63.       end;
  64.  end;
  65.  get_card := tempi;
  66. end;
  67.  
  68. procedure play_blackjack;
  69. var
  70.  total_computer,total_user: integer;
  71.  commandline: string;
  72.  command: char;
  73.  next: integer;
  74.  
  75. begin
  76.  total_computer := 0;
  77.  total_user := 0;
  78.  write_com('Computer has ');
  79.  inc(total_computer,get_card);
  80.  writelncom;
  81.  write_com('You have ');
  82.  inc(total_user,get_card);
  83.  write_com(' and ');
  84.  inc(total_user,get_card);
  85.  writelncom;
  86.  next := 2;
  87.  writelncom;
  88.  repeat
  89.   write_com('[S]tay or [H]it? ');
  90.   ask_user(commandline,1);
  91.   command := upcase(commandline[1]);
  92.   writelncom;
  93.   if command = 'H' then
  94.    begin
  95.     write_com('Taking the top card... ');
  96.     inc(total_user,get_card);
  97.     writelncom;
  98.    end;
  99.   if total_user > 21 then
  100.    begin
  101.     if (num_ace > 0) then
  102.      begin
  103.       dec(total_user,10);
  104.       dec(num_ace);
  105.      end
  106.     else
  107.      begin
  108.       writelncom;
  109.       writeln_com('You went OVER, you LOSE!');
  110.       exit;
  111.      end;
  112.    end;
  113.  until (drop_carrier) or (command = 'S');
  114.  writelncom;
  115.  write_com('The computer gets ... ');
  116.  repeat
  117.   inc(total_computer,get_card);
  118.   write_com('  ');
  119.   if total_computer = total_user then
  120.    begin
  121.     writelncom;
  122.     writeln_com('A TIE!');
  123.     inc(callinfo.upload_credit,to_gamble);
  124.     dec(taken_time,to_gamble);
  125.     exit;
  126.    end
  127.   else
  128.   if total_computer > 21 then
  129.    begin
  130.     writelncom;
  131.     writeln_com('The COMPUTER went over. YOU WIN!');
  132.     inc(callinfo.upload_credit,to_gamble*2);
  133.     dec(taken_time,to_gamble*2);
  134.     exit;
  135.    end
  136.   else
  137.   if total_computer > total_user then
  138.    begin
  139.     writelncom;
  140.     writeln_com('THE COMPUTER WINS!!  Too bad, LOSER!');
  141.     exit;
  142.    end;
  143.  until (drop_carrier);
  144. end;
  145.  
  146. var
  147.   name: string;
  148.   comment: string;
  149.  
  150. begin
  151.   begin_live_program('BlackJack for WINDOWS');
  152.   name := userinfo.name;
  153.   taken_time := 0;
  154.   delete_after_spaces(name);
  155.   writeln_com('Welcome '+name+' to PowerBBS for Windows BLACKJACK GAMBLE DOOR v1.1!');
  156.   writeln_com('A demonstration of PowerBBSs PowerDOORs interface.');
  157.   writelncom;
  158.   repeat
  159.    get_gamble;
  160.    if to_gamble <> 0 then play_blackjack;
  161.   until (drop_carrier) or (to_gamble = 0);
  162.   if taken_time = 0 then
  163.    activity('Broke even in BlackJack')
  164.   else
  165.    if taken_time > 0 then
  166.     activity('Lost '+int_to_asc(taken_time)+' minutes in BlackJack')
  167.   else
  168.    activity('Won '+int_to_asc(taken_time)+' minutes in BlackJack');
  169.   end_live_program;
  170. end.
  171.