From 8f4ccb7d931a04395d3aebe70eb2eba29cc9f18b Mon Sep 17 00:00:00 2001 From: hpyhacking Date: Tue, 26 Jul 2011 01:21:08 +0800 Subject: [PATCH] add openpoker server code --- openpoker-server/LICENSE.TXT | 281 ++++++++ openpoker-server/README | 7 + openpoker-server/doc/install.txt | 142 ++++ openpoker-server/doc/protocol.txt | 495 +++++++++++++ openpoker-server/doc/protocol_history.txt | 52 ++ openpoker-server/doc/release.txt | 116 +++ openpoker-server/src/betting.erl | 296 ++++++++ openpoker-server/src/bits.erl | 96 +++ openpoker-server/src/blinds.erl | 715 +++++++++++++++++++ openpoker-server/src/bot.erl | 384 ++++++++++ openpoker-server/src/cardgame.erl | 579 +++++++++++++++ openpoker-server/src/common.hrl | 31 + openpoker-server/src/counter.erl | 41 ++ openpoker-server/src/db.erl | 324 +++++++++ openpoker-server/src/deal_cards.erl | 142 ++++ openpoker-server/src/deck.erl | 169 +++++ openpoker-server/src/delayed_start.erl | 153 ++++ openpoker-server/src/fixed_limit.erl | 112 +++ openpoker-server/src/game.erl | 828 ++++++++++++++++++++++ openpoker-server/src/gateway.erl | 92 +++ openpoker-server/src/hand.erl | 735 +++++++++++++++++++ openpoker-server/src/id.erl | 41 ++ openpoker-server/src/ircdb.erl | 236 ++++++ openpoker-server/src/ircdb.hrl | 40 ++ openpoker-server/src/lang.erl | 35 + openpoker-server/src/lang.hrl | 25 + openpoker-server/src/login.erl | 192 +++++ openpoker-server/src/monitor.erl | 137 ++++ openpoker-server/src/multibot.erl | 687 ++++++++++++++++++ openpoker-server/src/observer.erl | 382 ++++++++++ openpoker-server/src/player.erl | 302 ++++++++ openpoker-server/src/pot.erl | 536 ++++++++++++++ openpoker-server/src/proto.erl | 489 +++++++++++++ openpoker-server/src/proto.hrl | 158 +++++ openpoker-server/src/schema.erl | 145 ++++ openpoker-server/src/schema.hrl | 85 +++ openpoker-server/src/server.erl | 329 +++++++++ openpoker-server/src/showdown.erl | 186 +++++ openpoker-server/src/tcp_server.erl | 180 +++++ openpoker-server/src/test.erl | 747 +++++++++++++++++++ openpoker-server/src/test.hrl | 119 ++++ openpoker-server/src/texas.hrl | 31 + openpoker-server/src/util.erl | 31 + openpoker-server/src/visitor.erl | 185 +++++ 44 files changed, 11088 insertions(+) create mode 100644 openpoker-server/LICENSE.TXT create mode 100644 openpoker-server/README create mode 100644 openpoker-server/doc/install.txt create mode 100644 openpoker-server/doc/protocol.txt create mode 100644 openpoker-server/doc/protocol_history.txt create mode 100644 openpoker-server/doc/release.txt create mode 100644 openpoker-server/src/betting.erl create mode 100644 openpoker-server/src/bits.erl create mode 100644 openpoker-server/src/blinds.erl create mode 100644 openpoker-server/src/bot.erl create mode 100644 openpoker-server/src/cardgame.erl create mode 100644 openpoker-server/src/common.hrl create mode 100644 openpoker-server/src/counter.erl create mode 100644 openpoker-server/src/db.erl create mode 100644 openpoker-server/src/deal_cards.erl create mode 100644 openpoker-server/src/deck.erl create mode 100644 openpoker-server/src/delayed_start.erl create mode 100644 openpoker-server/src/fixed_limit.erl create mode 100644 openpoker-server/src/game.erl create mode 100644 openpoker-server/src/gateway.erl create mode 100644 openpoker-server/src/hand.erl create mode 100644 openpoker-server/src/id.erl create mode 100644 openpoker-server/src/ircdb.erl create mode 100644 openpoker-server/src/ircdb.hrl create mode 100644 openpoker-server/src/lang.erl create mode 100644 openpoker-server/src/lang.hrl create mode 100644 openpoker-server/src/login.erl create mode 100644 openpoker-server/src/monitor.erl create mode 100644 openpoker-server/src/multibot.erl create mode 100644 openpoker-server/src/observer.erl create mode 100644 openpoker-server/src/player.erl create mode 100644 openpoker-server/src/pot.erl create mode 100644 openpoker-server/src/proto.erl create mode 100644 openpoker-server/src/proto.hrl create mode 100644 openpoker-server/src/schema.erl create mode 100644 openpoker-server/src/schema.hrl create mode 100644 openpoker-server/src/server.erl create mode 100644 openpoker-server/src/showdown.erl create mode 100644 openpoker-server/src/tcp_server.erl create mode 100644 openpoker-server/src/test.erl create mode 100644 openpoker-server/src/test.hrl create mode 100644 openpoker-server/src/texas.hrl create mode 100644 openpoker-server/src/util.erl create mode 100644 openpoker-server/src/visitor.erl diff --git a/openpoker-server/LICENSE.TXT b/openpoker-server/LICENSE.TXT new file mode 100644 index 0000000..98443f3 --- /dev/null +++ b/openpoker-server/LICENSE.TXT @@ -0,0 +1,281 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + diff --git a/openpoker-server/README b/openpoker-server/README new file mode 100644 index 0000000..aa6cee7 --- /dev/null +++ b/openpoker-server/README @@ -0,0 +1,7 @@ +OpenPoker is released under a dual GPL/commercial license. + +Please see doc/install.txt for installation instructions and visit http://groups.google.com/group/openpoker if you have questions. + +More information can also be found at http://wagerlabs.com. + + Thanks, Joel Reymont diff --git a/openpoker-server/doc/install.txt b/openpoker-server/doc/install.txt new file mode 100644 index 0000000..e9dde2c --- /dev/null +++ b/openpoker-server/doc/install.txt @@ -0,0 +1,142 @@ +I. Installation instructions + +1. Install Erlang/OTP. + +2. Unpack the contents of openpoker.tgz into a directory +and switch to that directory. Retrieve http://wagerlabs.com/ircdb.dat.gz and unpack it into src/ under the installation directory. Switch to the src/ directory. + +3. Pick a name for your Mnesia Master node. Lets assume master1. Recompile your files. + +erlc cardgame.erl +erlc betting.erl blinds.erl +erlc ... (the rest of your files) + +4. Figure out your fully qualified host name. You can get this +by running hostname on Unix. + +5. Run the following sequence from the installation directory: + +erl -sname master1 +schema:install([node()]). +halt(). + +Note that the dots (.) at the end of the install and halt commands are required! + +My scenario looks like this: + +bigdaddy:/tmp/release joelr$ erl -sname master1 +Erlang (BEAM) emulator version 5.4.6 [source] [hipe] [threads:0] + +Eshell V5.4.6 (abort with ^G) +(master1@bigdaddy)1> schema:install([node()]). +ok +(master1@bigdaddy)2> halt(). + +6. Make sure a directory called Mnesia.master1@... has been created. + +In my case: + +bigdaddy:/tmp/release joelr$ ls Mnesia.master1\@bigdaddy/ +LATEST.LOG game_history.DCD player_data.DCD +cluster_config.DCD game_xref.DCD schema.DAT +game_config.DCD player.DCD +bigdaddy:/tmp/release joelr$ + +7. Start the test harness. The test scenario assumes that the gateway will run on port 3000 and the game server will run on port 2000. The argument to setup is the host name of the computer where the game server is running. This host name should resolve so that poker clients can connect to it. + +In my case: + +erl -sname master1 -s mnesia start + +then + +(master@bigdaddy)1> test:all(). +Starting a port server on 10000... +Starting a port server on 10000... +Starting a port server on 10000... +334: CHAT: 0: Game is cancelled, not enough players +334: CANCEL +334: JOIN: 3 at seat#1 +334: JOIN: 4 at seat#2 +334: CHAT: 0: Game is starting +334: START +334: DEALER: seat#2 +334: SB: seat#1 +334: BB: seat#2 +334: BET: 3, 5.00 +334: BET: 4, 10.00 +334: CARD: 3 +334: CARD: 4 +334: CARD: 3 +334: CARD: 4 +334: STAGE: 1 +334: STATE: 3 = 2 +334: WIN: 4, 15.00 +334: END +Starting a port server on 10000... +Starting a port server on 10000... +ok + +then + +(master@bigdaddy)2> multibot:create_players(). +(master@bigdaddy)3> multibot:setup("bigdaddy"). +multibot:cleanup: deleting game info... +multibot:cleanup: deleting player info... +multibot:cleanup: deleting game info... +multibot:cleanup: deleting player info... +Starting a port server on 2000... +gateway:start(master@bigdaddy, 3000, 1000) +Waiting for game servers... +Starting a port server on 3000... +ok + +8. Run the tests + +In my case: + +(master@bigdaddy)4> multibot:test(localhost, 3000, 10). +gateway: 0.352000ms +gateway: 0.354000ms +gateway: 0.551000ms +gateway: 0.364000ms +gateway: 0.923000ms +gateway: 3.25000ms +gateway: 4.75000ms +gateway: 12.0250ms +Connecting to bigdaddy:2000 +Connecting to bigdaddy:2000 +Connecting to bigdaddy:2000 +Connecting to bigdaddy:2000 +Connecting to bigdaddy:2000 +Connecting to bigdaddy:2000 +Connecting to bigdaddy:2000 +Connecting to bigdaddy:2000 +gateway: 0.282000ms +gateway: 0.368000ms +Connecting to bigdaddy:2000 +Connecting to bigdaddy:2000 +Elapsed: 11.9770s, Average run time: 1.19770 seconds +MultiBot exited, 11.9800 seconds elapsed +ok +(master@bigdaddy)5> halt(). + +9. Arguments to the distributed testing harness + +The first argument to multibot:test() is the host where the gateway +is running. The second is the port that the gateway is listening on + and the third argument is the number of games +to run simultaneously. You can also add "true" as a fourth parameter, +to get lots of tracing output: + +multibot:test(localhost, 3000, 10, true). + +Multibot launches the given number of games simultaneously +and an "observer" bot is launched to watch each game. +Passing true as the fourth parameter to multibot:test() +tells the observer to print what it sees. + +Note that the default installation is limited to 100 simultaneous games. + +10. The test harness really tries to overwhelm the test setup by connecting very rapidly so you might see connection refused and similar errors. I'm working these out. + diff --git a/openpoker-server/doc/protocol.txt b/openpoker-server/doc/protocol.txt new file mode 100644 index 0000000..1d9b46f --- /dev/null +++ b/openpoker-server/doc/protocol.txt @@ -0,0 +1,495 @@ +*** General notes *** + +Packet format: + +0 1 2 N ++--+---+--- ... + +| Size | Body | ++------+--- ... + + +Body: + +0 1 N ++------+--- ... ---+ +| Type | Arguments | ++------+--- ... ---+ + +Strings: + +Maximum length is 255 characters. + +0 1 N ++--------+--- ... ----- + +| Length | Characters | ++--------+--- ... ------+ + +Integers: + +Unsigned, big-endian, 32 bit unless specificied otherwise. + +Amounts: + +Sent as integers, need to be divided by 100. + +Multiple games: + +The server allows a single player to participate in multiple games at the same time. There is no limit on the number of games that a player can participate in. + +Game and player identifiers: + +GID = Game ID, PID = Player ID. +PID and GID are integers. + +PID 0 belongs to the server. + +*** Commands sent from the client to the server *** + +LOGIN: + +Will receive PID in response. + +If reconnect succeeded a stream of game events will follow, starting with the first packet generated by the game after the connection was broken. + +Nick: String +Password: String + +0 1 ++---+------+----------+ +| 1 | Nick | Password | ++---+------+----------+ + +LOGOUT: + +0 1 ++---+ +| 2 | ++---+ + +WATCH: + +Start to game updates. A stream of packets will be sent when subscribing to a game that has already started. Further updates will be sent one by one. + +0 1 5 ++---+-----+ +| 3 | GID | ++---+-----+ + +UNWATCH: + +Stop game updates. + +0 1 5 ++---+-----+ +| 4 | GID | ++---+-----+ + +CALL: + +Call a previous bet. Call 0 to "check". + +0 1 5 9 ++---+-----+--------+ +| 6 | GID | Amount | ++---+-----+--------+ + +RAISE: + +Raise a previous bet. + +0 1 5 9 ++---+-----+--------+ +| 7 | GID | Amount | ++---+-----+--------+ + +FOLD: + +0 1 5 ++---+-----+ +| 8 | GID | ++---+-----+ + +JOIN: + +Join a game by taking a seat. PP_NOTIFY_JOIN with your PID will be sent if successful. + +0 1 5 6 10 ++---+-----+-------+---------+ +| 9 | GID | Seat# | Buy-in$ | ++---+-----+-------+---------+ + +LEAVE: + +Leave a game. + +0 1 5 ++----+-----+ +| 10 | GID | ++----+-----+ + +SITOUT: + +Stay at the table without playing. + +0 1 5 ++----+-----+ +| 11 | GID | ++----+-----+ + +SITIN: + +Come back into a game. Might require making up the blinds. PP_PLAYER_STATE with your PID will be sent if successful. + +0 1 5 ++----+-----+ +| 12 | GID | ++----+-----+ + +CHAT: + +Message: String + +0 1 5 N ++----+-----+---------+ +| 13 | GID | Message | ++----+-----+---------+ + +GAME_QUERY: + +OP: 0 - ignore, 1 - equals, 2 - less, 3 - greater. + +See GAME for details. + +0 1 2 3 4 5 6 7 8 9 ++----+--------+--------+----+--------+----+--------+----+---------+ +| 37 | G.Type | L.Type | OP | #Seats | OP | Joined | OP | Waiting | ++----+--------+--------+----+--------+----+--------+----+---------+ + +SEAT_QUERY: + +Ask for SEAT_STATE packets. One will be sent for each seat in the game. + +0 1 5 ++----+-----+ +| 39 | GID | ++----+-----+ + +PLAYER_INFO: + +Ask for a PLAYER packet for this PID. + +0 1 5 ++----+-----+ +| 40 | PID | ++----+-----+ + +CREATE_GAME: + +Create a new game. See GAME for field descriptions. +GOOD will be sent by the server if successful and EXTRA will contain the GID, BAD will be sent otherwise. + +0 1 2 3 4 8 12 ++----+--------+--------+--------+------+-------+ +| 41 | G.Type | #Seats | L.Type | Low$ | High$ | ++----+--------+--------+--------+------+-------+ + +BALANCE_INFO: + +Retrieve own account and inplay balances. +BALANCE is sent in response. + +0 1 5 ++----+-----+ +| 42 | PID | ++----+-----+ + +*** Commands sent from the server to the client *** + +GOOD: + +Command was accepted. + +CMD: Command code such as LOGOUT, etc. +EXTRA: Used as needed. + +0 1 2 6 ++---+-----+-------+ +| 0 | CMD | EXTRA | ++---+-----+-------+ + +BAD: + +Command was not accepted, error code describes the problem. + +CMD: Command code such as LOGIN, etc. +ERROR: See bottom of this document for the list of error codes. + +0 1 2 3 ++-----+-----+-------+ +| 250 | CMD | ERROR | ++-----+-----+-------+ + +PID: + +Player is assigned id PID. Sent in response to LOGIN. + +0 1 5 ++----+-----+ +| 35 | PID | ++----+-----+ + +HANDOFF: + +Sent by the load-balancer /gateway/ in response to a client connection. Client should reconnect to the given host and port. + +Host: String + +0 1 3 N ++----+------+------+ +| 36 | Port | Host | ++----+------+------+ + +GAME_SUMMARY: + +Game summary information. The server will send one message per game running. + +G.Type: Game type. Currently 1 for Texas Hold'em. +L.Type: Limit type. Currently 1 for fixed limit. +#Seats: Number of players required to start the game, the number of seats. +Joined: Number of players joined. +Waiting: Number of players on the wait list. + +0 1 5 6 7 8 9 10 14 18 ++----+-----+--------+--------+--------+---------+--------+------+-------+ +| 14 | GID | G.Type | #Seats | Joined | Waiting | L.Type | Low$ | High$ | ++----+-----+--------+--------+--------+---------+--------+------+-------+ + +SEAT_STATE: + +Seat state. 0 - empty, 1 - reserved, 2 - taken. +PID will be 0 when the seat is empty. + +0 1 5 6 7 11 ++----+-----+-------+-------+-----+ +| 33 | GID | Seat# | State | PID | ++----+-----+-------+-------+-----+ + +PLAYER_INFO: + +Player summary info. +Nick: String. +Location: String. + +0 1 5 9 N1 N2 ++----+-----+----------+------+----------+ +| 15 | PID | In-Play$ | Nick | Location | ++----+-----+------+----------+----------+ + +BET_REQ: + +Bet request. +Call: Amount to call. +R.Min: Minimum raise. +R.Max: Maximum raise. + +0 1 5 9 13 17 19 ++----+-----+------+-------+-------+-----+ +| 17 | GID | Call | R.Min | R.Max | Seq | ++----+-----+------+-------+-------+-----+ + +NOTIFY_DRAW: + +Private card is dealt to player. Other players receive NOTIFY_PRIVATE. +Rank: + + A K Q J T 9 8 7 6 5 4 3 2 ++--+--+--+--+-+-+-+-+-+-+-+-+-+ +|13|12|11|10|9|8|7|6|5|4|3|2|1| ++--+--+--+--+-+-+-+-+-+-+-+-+-+ + +Suit: C = 1, D = 2, H = 3, S = 4 + +0 1 5 6 7 9 ++----+-----+------+------+-----+ +| 18 | GID | Rank | Suit | Seq | ++----+-----+------+------+-----+ + +NOTIFY_PRIVATE: + +Card was dealt to a player. +Nick: String. + +0 1 5 9 11 ++----+-----+-----+-----+ +| 19 | GID | PID | Seq | ++----+-----+-----+-----+ + +NOTIFY_SHARED: + +Shared card was dealt. See NOTIFY_DRAW. + +0 1 5 6 7 9 ++----+-----+------+------+-----+ +| 20 | GID | Rank | Suit | Seq | ++----+-----+------+------+-----+ + +NOTIFY_JOIN: + +Player joined. +Nick: String. + +0 1 5 9 10 12 ++----+-----+-----+-------+-----+ +| 21 | GID | PID | Seat# | Seq | ++----+-----+-----+-------+-----+ + +NOTIFY_LEAVE: + +Elvis has left the building. +Nick: String. + +0 1 5 9 11 ++----+-----+-----+-----+ +| 22 | GID | PID | Seq | ++----+-----+-----+-----+ + +NOTIFY_CHAT: + +Chat message from PID. +Nick, Message: String + +0 1 5 9 11 N ++----+-----+-----+-----+---------+ +| 23 | GID | PID | Seq | Message | ++----+-----+-----+-----+---------+ + +NOTIFY_START: + +Game started. + +0 1 5 7 ++----+-----+-----+ +| 24 | GID | Seq | ++----+-----+-----+ + +NOTIFY_END: + +Game ended. + +0 1 5 7 ++----+-----+-----+ +| 25 | GID | Seq | ++----+-----+-----+ + +NOTIFY_CANCEL: + +Game was cancelled. + +0 1 5 7 ++----+-----+-----+ +| 38 | GID | Seq | ++----+-----+-----+ + +NOTIFY_WIN: + +PID wins Amount. + +0 1 5 9 13 15 ++----+-----+-----+--------+-----+ +| 26 | GID | PID | Amount | Seq | ++----+-----+-----+--------+-----+ + +NOTIFY_BUTTON: + +Seat# is the button. + +0 1 5 6 7 ++----+-----+-------+-----+ +| 34 | GID | Seat# | Seq | ++----+-----+-------+-----+ + +NOTIFY_SB: + +Seat# is the small blind. + +0 1 5 6 7 ++----+-----+-------+-----+ +| 44 | GID | Seat# | Seq | ++----+-----+-------+-----+ + +NOTIFY_BB: + +Seat# is the big blind. + +0 1 5 6 7 ++----+-----+-------+-----+ +| 45 | GID | Seat# | Seq | ++----+-----+-------+-----+ + +NOTIFY_BET: + +PID posts a bet. + +0 1 5 9 13 15 ++----+-----+-----+--------+-----+ +| 27 | GID | PID | Amount | Seq | ++----+-----+-----+--------+-----+ + +NOTIFY_RAISE: + +PID raises Amount. + +0 1 5 9 13 15 ++----+-----+-----+--------+-----+ +| 29 | GID | PID | Amount | Seq | ++----+-----+-----+--------+-----+ + +NOTIFY_CALL: + +PID calls Amount. + +0 1 5 9 13 15 ++----+-----+-----+--------+-----+ +| 30 | GID | PID | Amount | Seq | ++----+-----+-----+--------+-----+ + +NOTIFY_STATE: + +Player state change. + +State: + +1 - playing, 2 - folded, 3 - waiting for big blind, +4 - all in, 5 - sitting out. + +0 1 5 9 10 12 ++----+-----+-----+-------+-----+ +| 31 | GID | PID | State | Seq | ++----+-----+-----+-------+-----+ + +NOTIFY_STAGE: + +New game stage. +Stage: + +1 - preflop, 2 - flop, 3 - turn, 4 - river. + +0 1 5 6 8 ++----+-----+-------+-----+ +| 32 | GID | Stage | Seq | ++----+-----+-------+-----+ + +BALANCE: + +Player balance. + +0 1 5 9 ++----+----------+----------+ +| 43 | Balance$ | In-play$ | ++----+----------+----------+ + +*** Error codes *** + +0 - Unknown error +1 - Login error, bad nick or password. +2 - Account locked out, contact poker room administration. +3 - START_GAME disabled. diff --git a/openpoker-server/doc/protocol_history.txt b/openpoker-server/doc/protocol_history.txt new file mode 100644 index 0000000..3a09347 --- /dev/null +++ b/openpoker-server/doc/protocol_history.txt @@ -0,0 +1,52 @@ +*** September 22, 2005 11:41:33 AM *** + +Changed COMEBACK to SITIN. +Changed START_GAME to CREATE_GAME. +Changed GAME to GAME_SUMMARY. +Changed PLAYER to PLAYER_SUMMARY. +Changed NOTIFY_BUTTON to use seat# instead of PID. + +Removed NOTIFY_SMALL_BLIND and NOTIFY_BIG_BLIND and added NOTIFY_BET (#27) instead. +Removed NOTIFY_DEALER as NOTIFY_BUTTON should suffice. +Changed BLIND to BET and eliminated it entirely. +Removed BLID_REQ as RAISE should be used instead. +Changed PLAYER_SUMMARY to PLAYER_INFO. +Changed packet code for BAD to 250. + +Added NOTIFY_SB and NOTIFY_BB. + +*** August 29, 2005 4:48:33 PM *** + +Added GOOD, BAD, START_GAME. +Added error codes for BAD. +Removed PID from LOGIN. +Added BALANCE_INFO and BALANCE. +Added START_GAME. +Added NOTIFY_DEALER. + +*** July 7, 2005 5:38:57 PM *** + +Added SEAT_QUERY and PLAYER_INFO. +Minor fix to SEAT_STATE. + +*** June 16, 2005 10:47:43 PM *** + +Added NOTIFY_CANCEL. + +*** June 13, 2005 3:22:43 PM *** + +Added GAME_QUERY. + +*** June 9, 2005 9:39:10 AM *** + +Added HANDOFF. + +*** June 6, 2005 9:11:39 AM *** + +Added sequence numbers to outgoing packets. +Added PID to LOGIN to allow for reconnects. +Added buy-in amount to JOIN. +Updated description for LOGIN. + +Note that for LOGIN and NOTIFY_CHAT fields have changed order. + diff --git a/openpoker-server/doc/release.txt b/openpoker-server/doc/release.txt new file mode 100644 index 0000000..f415a2a --- /dev/null +++ b/openpoker-server/doc/release.txt @@ -0,0 +1,116 @@ +*** Release 0.97.0, 28/09/2005 *** + +Renamed some protocol-related variables for clarity. +Made multibot start games on the server. + +*** Release 0.96.0, 22/09/2005 *** + +OpenPoker is now truly open and released under a dual GPL/commercial license. + +Optimized the protocol a bit by replacing the BLIND request with a BET request. See protocol_history.txt for more changes. + +*** Release 0.95.1, 01/09/2005 *** + +1) Made sure that folded players are reset to playing at the start of the game. Players have a chance to sit out or choose to wait for the big blind during the pre-game waiting period. + +2) Fixed a blinds test that broke after #1. + +*** Release 0.95.0, 30/08/2005 *** + +1) New tools to poke around the database and administer the server. + +Tables can be emptied with db:delete(player), db:delete(game_xref), etc. +Individual items can be deleted with db:delete(). +Contents of db tables can be listed with db:find(player), etc. + +2) Changed protocol to add GOOD, BAD, error codes, etc. + +3) Change login procedure to return error codes. See bottom of protocol.txt for description of error codes. + +4) PID is no longer required when reconnecting. The reconnect procedure now handles disconnected clients, crashed servers and smooth reconnect of someone who is in a game from a different computer. Game event history is stored by the game and is sent to update the reconnecting player. + +5) Maximum bad login attempts can now be configured per server. Player account will be disabled after this number of bad login attempts. See example below. + +(master@bigdaddy)1> db:find(player, nick, "foo"). +{atomic,[]} +(master@bigdaddy)2> player:create("foo", "bar", "", 100). +{atomic,18} +(master@bigdaddy)3> db:find(player, nick, "foo"). +{atomic,[{player,18,"foo",963206692,[],100,0.00000e+0,0,none,none,none,false}]} +(master@bigdaddy)4> db:get(player, 18, disabled). +{atomic,false} +(master@bigdaddy)5> db:set(player, 18, {disabled, true}). +{atomic,ok} +(master@bigdaddy)6> db:get(player, 18, disabled). +{atomic,true} +(master@bigdaddy)7> db:delete(player, 18). +{atomic,ok} + +(master@bigdaddy)8> db:get(cluster_config, 0, max_login_errors). +{atomic,5} + +6) Restrict chat messages to players watching or playing at the table. Watchers were not allowed to chat before. Players must be logged in to chat. + +7) Do not require login (and thus registration) to watch games. + +8) Confirm logout with a GOOD message. Player is not disconnected from the server after logout but his server-side representation is replaced with a "visitor" process without a lot of powers. This is also the process that's started when someone connects to the server. + +9) Store a binary representation of the password instead of storing it in clear text. + +10) Check player buy-in amount before letting the player sit down at a table. + +11) Add ability to start games on-demand. This can be configured per cluster. + +(master@bigdaddy)9> db:get(cluster_config, 0, enable_dynamic_games). +{atomic,true} + +12) Add query to check your own balance. See BALANCE_INFO in the protocol. + +13) Buy out after leaving the table. Assuming a player has 1,000 when joining a table and buys in for 500, he will have 500 in his account balance and 500 in play. In-play amount is rolled into balance when player leaves. + +14) Add dealer notification. See NOTIFY_DEALER in the protocol. + +15) Added a test:all() test harness which can be run to make sure everything is sound. + +16) Fixed multibot to give time for number of open sockets (players) to build up. You should be able to do the following to launch 20k games: + +multibot:setup("my host or ip address"). +multibot:test("the one above", 3000, 20000, 150000). + +150000 is the time in milliseconds that each game will wait for bots. Bots will wait for one NOTIFY_CANCEL before joining and game won't start until another start delay has passed. 150 * 2 seconds is a lot of time to let sockets build up but you can increase it further. + +Use a really small start delay value to run through a few tests quickly. I was able to use a delay of 1 second on my laptop to run through 1000 games. + +multibot:test(bigdaddy, 3000, 1000, 1000). + +Make sure to launch setup from one machine and test from another to get good numbers. I was only able to get as high as 4,000 players on my PowerBook G4 1.25Ghz with Mac OSX 10.4.2 before I started getting time outs. I also had to increase the maximum number of file descriptors per process with "ulimit -n unlimited" (10240 on Mac OSX) and increase maximum number of processes for Erlang with + +erl +P 1000000 ... + +as well as increasing the number of open ports with + +export ERL_MAX_PORTS=10240 + +The timeouts were likely due to my running everything on a single node, slow laptop disk, 512mb of memory and a bunch of other programs that I was running at the time. + +You should be able to further increase performance by running the Mnesia master db on a separate machine with a fast disk and lots of memory. + +*** Release 0.90.1, 20/07/2005 *** + +1) Button now moves from game to game. + +2) ircdb.dat is supplied separately. + +*** Release 0.90.0, 18/07/2005 *** + +1) Allow game start delay and player timeout to be configurable via game_admin:add_table(GameType, SeatCount, Limit, Delay, Timeout, Max). + +2) Query number of players in real-time instead of having games update the database every time players join or leave. + +3) Fix inplay balance in SEAT_QUERY results. + +4) Increase connection timeout to 30 seconds for the tcp client and 15 seconds for the distributed tester. + +5) Have bots log out after leaving at the end of the game. + + diff --git a/openpoker-server/src/betting.erl b/openpoker-server/src/betting.erl new file mode 100644 index 0000000..31b4227 --- /dev/null +++ b/openpoker-server/src/betting.erl @@ -0,0 +1,296 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(betting). +-behaviour(cardgame). + +-export([stop/1, test/0]). + +-export([init/1, terminate/3]). +-export([handle_event/3, handle_info/3, + handle_sync_event/4, code_change/4]). + +-export([betting/2]). + +-include("common.hrl"). +-include("texas.hrl"). +-include("test.hrl"). +-include("proto.hrl"). + +-record(data, { + game, + context, + have_blinds, + max_raises, + stage, + expected, % {Player, Min, Max} + call, + raise_count, + timer + }). + +init([Game, MaxRaises, Stage]) -> + init([Game, MaxRaises, Stage, false]); + +init([Game, MaxRaises, Stage, HaveBlinds]) -> + Data = #data { + game = Game, + have_blinds = HaveBlinds, + max_raises = MaxRaises, + stage = Stage + }, + {ok, betting, Data}. + +stop(Ref) -> + cardgame:send_all_state_event(Ref, stop). + +betting({'START', Context}, Data) -> + Game = Data#data.game, + %% assume that we are given a record + Button = element(2, Context), + Call = element(3, Context), + %%io:format("betting/start: call = ~.2. f~n", [Call * 1.0]), + Active = gen_server:call(Game, {'SEATS', Button, ?PS_PLAY}), + PlayerCount = length(Active), + if + PlayerCount < 2 -> + {stop, {normal, Context}, Data}; + true -> + _Total = gen_server:call(Game, 'POT TOTAL'), + gen_server:cast(Game, {'BROADCAST', + {?PP_GAME_STAGE, Data#data.stage}}), + if + Data#data.have_blinds -> + %% start with the player after the big blind + BB = element(6, Context), + Temp = gen_server:call(Game, {'SEATS', BB, ?PS_PLAY}), + Player = hd(Temp); + true -> + %% start with the first player after the button + Player = hd(Active) + end, + Data1 = Data#data { + context = Context, + call = Call, + raise_count = 0 + }, + Data2 = ask_for_bet(Data1, Player), + {next_state, betting, Data2} + end; + +betting({?PP_CALL, Player, Amount}, Data) -> + Game = Data#data.game, + {Expected, Call, _Min, _Max} = Data#data.expected, + if + Expected /= Player -> + {next_state, betting, Data}; + true -> + %% it's us + cancel_timer(Data), + InPlay = gen_server:call(Player, 'INPLAY'), + if + Amount > InPlay -> + betting({?PP_FOLD, Player}, Data); + Amount > Call -> + betting({?PP_FOLD, Player}, Data); + Amount == InPlay -> + %% all-in + gen_server:cast(Game, {'ADD BET', Player, Amount}), + next_turn(Data, Player); + true -> + %% proper bet + gen_server:cast(Game, {'SET STATE', Player, ?PS_BET}), + gen_server:cast(Game, {'ADD BET', Player, Amount}), + gen_server:cast(Game, {'BROADCAST', {?PP_NOTIFY_CALL, + Player, Call}}), + next_turn(Data, Player) + end + end; + +betting({?PP_RAISE, Player, Amount}, Data) -> + Game = Data#data.game, + RaiseCount = Data#data.raise_count, + {Expected, Call, Min, Max} = Data#data.expected, + if + Expected /= Player -> + {next_state, betting, Data}; + true -> + %% it's us + cancel_timer(Data), + InPlay = gen_server:call(Player, 'INPLAY'), + if + (Amount > InPlay) or + (Amount > Max) or + (Max == 0) or % should have sent CALL + ((Amount < Min) and ((Amount + Call) /= InPlay)) -> + betting({?PP_FOLD, Player}, Data); + true -> + %% proper raise + RaiseCount1 = if + Call /= 0 -> + RaiseCount + 1; + true -> + RaiseCount + end, + gen_server:cast(Game, {'ADD BET', Player, Amount + Call}), + gen_server:cast(Game, {'RESET STATE', ?PS_BET, ?PS_PLAY}), + if + Amount + Call == InPlay -> + ok; + true -> + gen_server:cast(Game, + {'SET STATE', Player, ?PS_BET}) + end, + gen_server:cast(Game, {'BROADCAST', {?PP_NOTIFY_RAISE, + Player, Amount}}), + Data1 = Data#data { + call = Data#data.call + Amount, + raise_count = RaiseCount1 + }, + next_turn(Data1, Player) + end + end; + +betting({?PP_FOLD, Player}, Data) -> + {Expected, _Call, _Min, _Max} = Data#data.expected, + if + Expected /= Player -> + {next_state, betting, Data}; + true -> + cancel_timer(Data), + gen_server:cast(Data#data.game, {'SET STATE', Player, ?PS_FOLD}), + gen_server:cast(Data#data.game, {'BROADCAST', + {?PP_PLAYER_STATE, + Player, + ?PS_FOLD}}), + next_turn(Data, Player) + end; + +betting({timeout, _Timer, Player}, Data) -> + cancel_timer(Data), + Game = Data#data.game, + GID = gen_server:call(Game, 'ID'), + Seat = gen_server:call(Game, {'WHAT SEAT', Player}), + error_logger:warning_report([{message, "Player timeout!"}, + {module, ?MODULE}, + {player, Player}, + {game, GID}, + {seat, Seat}]), + %% + %%io:format("~w timed out, folding~n", [Player]), + betting({?PP_FOLD, Player}, Data); + +betting(Event, Data) -> + handle_event(Event, betting, Data). + +handle_event(stop, _State, Data) -> + {stop, normal, Data}; + +handle_event(Event, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {message, Event}, + {self, self()}, + {game, Data#data.game}, + {expected, Data#data.expected}]), + {next_state, State, Data}. + +handle_sync_event(Event, From, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {message, Event}, + {from, From}, + {self, self()}, + {game, Data#data.game}, + {expected, Data#data.expected}]), + {next_state, State, Data}. + +handle_info(Info, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {message, Info}, + {self, self()}, + {game, Data#data.game}, + {expected, Data#data.expected}]), + {next_state, State, Data}. + +terminate(_Reason, _State, _Data) -> + ok. + +code_change(_OldVsn, State, Data, _Extra) -> + {ok, State, Data}. + +%% +%% Utility +%% + +next_turn(Data, Player) -> + Game = Data#data.game, + Seat = gen_server:call(Game, {'WHAT SEAT', Player}), + Active = gen_server:call(Game, {'SEATS', Seat, ?PS_PLAY}), + Standing = gen_server:call(Game, {'SEATS', Seat, ?PS_STANDING}), + ActiveCount = length(Active), + StandingCount = length(Standing), + if + StandingCount < 2 -> + %% last man standing wins + {stop, {endgame, Data#data.context}, Data}; + ActiveCount == 0 -> + %% we are done with this stage + gen_server:cast(Game, {'RESET STATE', ?PS_BET, ?PS_PLAY}), + Ctx = setelement(3, Data#data.context, 0), % call = 0 + gen_server:cast(Game, 'NEW STAGE'), + {stop, {normal, Ctx}, Data}; + true -> + %% next player + Data1 = ask_for_bet(Data, hd(Active)), + {next_state, betting, Data1} + end. + +ask_for_bet(Data, Seat) -> + Game = Data#data.game, + Stage = Data#data.stage, + Player = gen_server:call(Game, {'PLAYER AT', Seat}), + Bet = gen_server:call(Game, {'BET TOTAL', Player}), + Call = Data#data.call - Bet, + {Min, Max} = gen_server:call(Game, {'RAISE SIZE', Player, Stage}), + Parent = gen_server:call(Data#data.game, 'FSM'), + gen_server:cast(Player, {?PP_BET_REQ, Parent, Call, Min, Max}), + Data1 = restart_timer(Data, Player), + Data1#data { + expected = {Player, Call, Min, Max} + }. + +cancel_timer(Data) -> + catch cardgame:cancel_timer(Data#data.timer). + +restart_timer(Data, Msg) -> + Timeout = gen_server:call(Data#data.game, 'TIMEOUT'), + Data#data { + timer = cardgame:start_timer(Timeout, Msg) + }. + +%% +%% Test suite +%% + +test() -> + ok. diff --git a/openpoker-server/src/bits.erl b/openpoker-server/src/bits.erl new file mode 100644 index 0000000..1a45c10 --- /dev/null +++ b/openpoker-server/src/bits.erl @@ -0,0 +1,96 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(bits). +-export([bits0/1, bits1/1, log2/1, tzb0/1, tzb1/1, clear_extra_bits/2]). + +%%% Courtesy of Mark Scandariato + +%% number of bits set +% bits0 works on arbitrary integers. + +bits0(N) when N >= 0-> bits0(N, 0). +bits0(0, C) -> C; +bits0(N, C) -> + bits0((N band (N-1)), C+1). + +clear_extra_bits(N, _) when N =:= 0 -> + N; + +clear_extra_bits(N, X) -> + C = bits0(N), + if + X >= C -> + N; + true -> + clear_extra_bits(N, X, C) + end. + +clear_extra_bits(N, X, C) when N =:= 0; C =:= 0; X =:= C -> + N; +clear_extra_bits(N, X, C) -> + clear_extra_bits(N band (N - 1), X, C - 1). + +bits1(0) -> 0; +bits1(N) when N > 0, N < 16#100000000 -> + bits1(N, [1, 16#55555555, + 2, 16#33333333, + 4, 16#0F0F0F0F, + 8, 16#00FF00FF, + 16, 16#0000FFFF]). + +bits1(N, []) -> N; +bits1(N, [S, B|Magic]) -> + bits1(((N bsr S) band B) + (N band B), Magic). + + +%% log2, aka, position of the high bit + +log2(N) when N > 0, N < 16#100000000 -> + log2(N, 0, [16, 16#FFFF0000, 8, 16#FF00, 4, 16#F0, 2, 16#C, 1, 16#2]). + +log2(_, C, []) -> C; +log2(N, C, [S,B|Magic]) -> + if (N band B) == 0 -> log2(N, C, Magic); + true -> log2((N bsr S), (C bor S), Magic) + end. + +%% trailing zero bits, aka position of the lowest set bit. + +tzb0(N) when N > 0, N < 16#100000000 -> + tzb0(N, 32, [16, 16#0000FFFF, + 8, 16#00FF00FF, + 4, 16#0F0F0F0F, + 2, 16#33333333, + 1, 16#55555555]). + +tzb0(_, Z, []) -> Z-1; +tzb0(N, Z, [S, B|Magic]) -> + if (N band B) == 0 -> tzb0(N, Z, Magic); + true -> tzb0((N bsl S), (Z - S), Magic) + end. + +tzb1(N) when N > 0, N < 16#100000000 -> + Mod = {32,0,1,26,2,23,27,0,3,16,24,30, + 28,11,0,13,4,7,17,0,25,22,31,15, + 29,10,12,6,0,21,14,9,5,20,8,19,18}, + P = (-N band N) rem 37, + element(P+1, Mod). diff --git a/openpoker-server/src/blinds.erl b/openpoker-server/src/blinds.erl new file mode 100644 index 0000000..67fad5c --- /dev/null +++ b/openpoker-server/src/blinds.erl @@ -0,0 +1,715 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(blinds). +-behaviour(cardgame). + +-export([stop/1, test/0]). + +-export([init/1, terminate/3]). +-export([handle_event/3, handle_info/3, + handle_sync_event/4, code_change/4]). + +-export([small_blind/2, big_blind/2]). + +-include("common.hrl"). +-include("test.hrl"). +-include("texas.hrl"). +-include("proto.hrl"). + +-record(data, { + game, + context, + small_blind_seat, + big_blind_seat, + button_seat, + no_small_blind, + small_blind_amount, + small_blind_bet, + big_blind_amount, + timer, + expected, % {Player, Seat, Amount} + type + }). + +init([Game]) -> + init([Game, normal]); + +init([Game, Type]) -> + {Small, Big} = gen_server:call(Game, 'BLINDS'), + Data = #data { + game = Game, + small_blind_amount = Small, + big_blind_amount = Big, + small_blind_bet = 0, + no_small_blind = false, + timer = none, + expected = {none, 0}, + type = Type + }, + {ok, small_blind, Data}. + +stop(Ref) -> + cardgame:send_all_state_event(Ref, stop). + +%% Theory + +%% Heads-up play. The small blind is the button and acts first +%% before the flop and last after the flop. The player +%% who does not have the button is dealt the first card. + +%% There are three players remaining and one is eliminated. +%% Determine which player would have been the next big blind +%% ... that player becomes the big blind and the other player +%% is the small blind (and button). + +%% Small blind is eliminated. The player who was the big blind +%% now posts the small blind and the player to his left +%% posts the big blind. The button does not move and the player +%% who was the button, will be the button once again. + +%% Big blind is eliminated. The player to the left of the eliminated +%% big blind now posts the big blind and there is no small blind +%% for that hand. The button moves to the player who was the small blind. +%% On the following hand, the button does not move and the two blinds +%% are posted normally. + +small_blind({'START', Context}, Data) -> + if + Data#data.type /= irc -> + Data1 = Data#data { + context = Context, + small_blind_seat = Context#texas.small_blind_seat, + big_blind_seat = Context#texas.big_blind_seat, + button_seat = Context#texas.button_seat + }; + true -> + Data1 = Data#data { + context = Context, + small_blind_seat = none, + big_blind_seat = none, + button_seat = none + } + end, + Game = Data1#data.game, + %% advance button and broadcast position + {Button1, Bust} = advance_button(Data1), + gen_server:cast(Game, {'BROADCAST', {?PP_NOTIFY_BUTTON, Button1}}), + %% collect blinds + SBPlayers = gen_server:call(Game, {'SEATS', Button1, ?PS_ACTIVE}), + BBPlayers = gen_server:call(Game, {'SEATS', Button1, ?PS_BB_ACTIVE}), + L1 = length(SBPlayers), + L2 = length(BBPlayers), + HeadsUp = ((L1 == 2) and (L2 == 2)) % two active, 0 waiting for bb + or ((L1 == 1) and (L2 == 2)), % one active, one waiting for bb + BB_N = length(BBPlayers), + if + BB_N < 2 -> + {stop, {normal, restart}, Data1}; + Bust and not HeadsUp -> + %% there's no small blind so the first player + %% after the button is the big blind + Data2 = Data1#data { + button_seat = Button1, + no_small_blind = true, + small_blind_seat = Data1#data.big_blind_seat + }, + Amount = Data2#data.big_blind_amount, + %% ask for big blind + Data3 = ask_for_blind(Data2, hd(BBPlayers), Amount), + {next_state, big_blind, Data3}; + Bust and HeadsUp -> + %% the first player after the button + %% is the big blind and the other player + %% is the small blind and button + Data2 = Data1#data { + button_seat = Button1 + }, + Amount = Data2#data.small_blind_amount, + Data3 = ask_for_blind(Data2, lists:last(SBPlayers), Amount), + {next_state, small_blind, Data3}; + true -> + Data2 = Data1#data { + button_seat = Button1 + }, + Amount = Data2#data.small_blind_amount, + Data3 = ask_for_blind(Data2, hd(SBPlayers), Amount), + {next_state, small_blind, Data3} + end; + +small_blind({?PP_CALL, Player, Amount}, Data) -> + Game = Data#data.game, + {ExpPlayer, Seat, ExpAmount} = Data#data.expected, + if + ExpPlayer /= Player -> + {next_state, small_blind, Data}; + true -> + %% it's us + cancel_timer(Data), + InPlay = gen_server:call(Player, 'INPLAY'), + if + (ExpAmount /= Amount) and + (InPlay /= Amount) -> + timeout(Data, Player, small_blind); + true -> + %% small blind posted + Data1 = Data#data { + small_blind_seat = Seat, + small_blind_bet = Amount + }, + BBPlayers = gen_server:call(Game, + {'SEATS', Seat, ?PS_BB_ACTIVE}), + Data2 = ask_for_blind(Data1, + hd(BBPlayers), + Data1#data.big_blind_amount), + {next_state, big_blind, Data2} + end + end; + +small_blind({?PP_FOLD, Player}, Data) -> + {ExpPlayer, _Seat, _ExpAmount} = Data#data.expected, + if + ExpPlayer /= Player -> + {next_state, small_blind, Data}; + true -> + timeout(Data, Player, small_blind) + end; + +small_blind({timeout, _Timer, Player}, Data) -> + cancel_timer(Data), + Game = Data#data.game, + GID = gen_server:call(Game, 'ID'), + Seat = gen_server:call(Game, {'WHAT SEAT', Player}), + error_logger:warning_report( + [{message, "Player timeout!"}, + {module, ?MODULE}, + {state, small_blind}, + {player, Player}, + {game, GID}, + {seat, Seat}, + {now, now()}]), + timeout(Data, Player, small_blind); + +small_blind({?PP_JOIN, Player, SeatNum, BuyIn}, Data) -> + join(Data, Player, SeatNum, BuyIn, small_blind); + +small_blind({?PP_LEAVE, Player}, Data) -> + leave(Data, Player, small_blind); + +small_blind({?PP_SIT_OUT, Player}, Data) -> + sit_out(Data, Player, small_blind); + +small_blind({?PP_COME_BACK, Player}, Data) -> + come_back(Data, Player, small_blind); + +small_blind(Event, Data) -> + handle_event(Event, small_blind, Data). + +big_blind({?PP_CALL, Player, Amount}, Data) -> + Game = Data#data.game, + {ExpPlayer, Seat, ExpAmount} = Data#data.expected, + if + ExpPlayer /= Player -> + {next_state, big_blind, Data}; + true -> + %% it's us + cancel_timer(Data), + InPlay = gen_server:call(Player, 'INPLAY'), + if + (ExpAmount /= Amount) and + (InPlay /= Amount) -> + timeout(Data, Player, big_blind); + true -> + %% big blind posted + SB = Data#data.small_blind_seat, + BB = Seat, + SBPlayer = gen_server:call(Game, {'PLAYER AT', SB}), + BBPlayer = Player, + gen_server:cast(Game, {'SET STATE', SBPlayer, ?PS_PLAY}), + gen_server:cast(Game, {'SET STATE', BBPlayer, ?PS_PLAY}), + %% record blind bets + Small = Data#data.small_blind_bet, + Big = Amount, + if + Data#data.no_small_blind -> + ok; + true -> + gen_server:cast(Game, {'ADD BET', SBPlayer, Small}) + end, + gen_server:cast(Game, {'ADD BET', BBPlayer, Big}), + %% adjust button if a heads-up game + Seats = gen_server:call(Game, {'SEATS', ?PS_ACTIVE}), + if + (length(Seats) == 2) and (Data#data.type /= irc) -> + Button = SB; + true -> + Button = Data#data.button_seat + end, + Data1 = Data#data { + big_blind_seat = BB, + button_seat = Button, + expected = {none, none, 0} + }, + %% notify players + gen_server:cast(Game, {'BROADCAST', {?PP_NOTIFY_SB, SB}}), + gen_server:cast(Game, {'BROADCAST', {?PP_NOTIFY_BB, BB}}), + gen_server:cast(Game, {'BROADCAST', + {?PP_NOTIFY_BET, SBPlayer, Small}}), + gen_server:cast(Game, {'BROADCAST', + {?PP_NOTIFY_BET, BBPlayer, Big}}), + Ctx = Data#data.context, + Ctx1 = Ctx#texas { + call = Amount, + small_blind_seat = SB, + big_blind_seat = BB, + button_seat = Button + }, + {stop, {normal, Ctx1}, Data1} + end + end; + +big_blind({?PP_FOLD, Player}, Data) -> + {ExpPlayer, _Seat, _ExpAmount} = Data#data.expected, + if + ExpPlayer /= Player -> + {next_state, big_blind, Data}; + true -> + timeout(Data, Player, big_blind) + end; + +big_blind({timeout, _Timer, Player}, Data) -> + cancel_timer(Data), + Game = Data#data.game, + GID = gen_server:call(Game, 'ID'), + Seat = gen_server:call(Game, {'WHAT SEAT', Player}), + error_logger:warning_report( + [{message, "Player timeout!"}, + {module, ?MODULE}, + {state, big_blind}, + {player, Player}, + {game, GID}, + {seat, Seat}, + {now, now()}]), + timeout(Data, Player, big_blind); + +big_blind({?PP_JOIN, Player, SeatNum, BuyIn}, Data) -> + join(Data, Player, SeatNum, BuyIn, big_blind); + +big_blind({?PP_LEAVE, Player}, Data) -> + leave(Data, Player, big_blind); + +big_blind({?PP_SIT_OUT, Player}, Data) -> + sit_out(Data, Player, big_blind); + +big_blind({?PP_COME_BACK, Player}, Data) -> + come_back(Data, Player, big_blind); + +big_blind(Event, Data) -> + handle_event(Event, big_blind, Data). + +handle_event(stop, _State, Data) -> + {stop, normal, Data}; + +handle_event(Event, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {where, handle_event}, + {message, Event}, + {self, self()}, + {game, Data#data.game}, + {expected, Data#data.expected}, + {sb, Data#data.small_blind_seat}, + {bb, Data#data.big_blind_seat}, + {b, Data#data.button_seat}]), + {next_state, State, Data}. + +handle_sync_event(Event, From, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {where, handle_sync_event}, + {message, Event}, + {from, From}, + {self, self()}, + {game, Data#data.game}, + {expected, Data#data.expected}, + {sb, Data#data.small_blind_seat}, + {bb, Data#data.big_blind_seat}, + {b, Data#data.button_seat}]), + {next_state, State, Data}. + +handle_info(Info, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {where, handle_info}, + {message, Info}, + {self, self()}, + {game, Data#data.game}, + {expected, Data#data.expected}, + {sb, Data#data.small_blind_seat}, + {bb, Data#data.big_blind_seat}, + {b, Data#data.button_seat}]), + {next_state, State, Data}. + +terminate(_Reason, _State, _Data) -> + ok. + +code_change(_OldVsn, State, Data, _Extra) -> + {ok, State, Data}. + +%% +%% Utility +%% + +timeout(Data, Player, State) -> + cancel_timer(Data), + Game = Data#data.game, + Seat = gen_server:call(Game, {'WHAT SEAT', Player}), + case State of + small_blind -> + Players = gen_server:call(Game, {'SEATS', Seat, ?PS_ACTIVE}), + Amount = Data#data.small_blind_amount, + Expected = 2; + _ -> + Temp = gen_server:call(Game, {'SEATS', Seat, ?PS_BB_ACTIVE}), + %% remove small blind + Players = lists:delete(Data#data.small_blind_seat, Temp), + Amount = Data#data.big_blind_amount, + Expected = 1 + end, + Players1 = lists:delete(Seat, Players), + %%gen_server:cast(Game, {?PP_LEAVE, Player}), % kick player + gen_server:cast(Game, {'SET STATE', Player, ?PS_SIT_OUT}), + if + length(Players1) < Expected -> + {stop, {normal, restart}, Data}; + true -> + Data1 = ask_for_blind(Data, hd(Players1), Amount), + {next_state, State, Data1} + end. + + +join(Data, Player, SeatNum, BuyIn, State) -> + Game = Data#data.game, + gen_server:cast(Game, {?PP_JOIN, Player, SeatNum, BuyIn, ?PS_MAKEUP_BB}), + {next_state, State, Data}. + +leave(Data, Player, State) -> + Game = Data#data.game, + Seat = gen_server:call(Game, {'WHAT SEAT', Player}), + if + %% small blind can't leave + %% while we are collecting + %% the big blind + (State == big_blind) and + (Seat == Data#data.small_blind_seat) -> + oops; + true -> + gen_server:cast(Game, {?PP_LEAVE, Player}) + end, + {next_state, State, Data}. + +sit_out(Data, Player, State) -> + gen_server:cast(Data#data.game, {'SET STATE', Player, ?PS_SIT_OUT}), + {next_state, State, Data}. + +come_back(Data, Player, State) -> + gen_server:cast(Data#data.game, {'SET STATE', Player, ?PS_PLAY}), + {next_state, State, Data}. + +advance_button(Data) -> + Game = Data#data.game, + B = Data#data.button_seat, + if + B == none -> + %% first hand of the game + %% start with the first player + Players = gen_server:call(Game, {'SEATS', ?PS_ANY}), + Button = lists:last(Players), + Bust = false; + true -> + %% start with the first + %% player after the button + Players = gen_server:call(Game, {'SEATS', B, ?PS_ANY}), + Button = hd(Players), + %% big blind is bust + BB = Data#data.big_blind_seat, + BBPlayer = gen_server:call(Game, {'PLAYER AT', BB}), + State = gen_server:call(Game, {'STATE', BBPlayer}), + Bust = ?PS_FOLD == State + end, + {Button, Bust}. + +ask_for_blind(Data, Seat, Amount) -> + Game = Data#data.game, + FSM = gen_server:call(Game, 'FSM'), + Player = gen_server:call(Game, {'PLAYER AT', Seat}), + gen_server:cast(Player, {?PP_BET_REQ, FSM, Amount, 0, 0}), + Data1 = restart_timer(Data, Player), + Data1#data { + expected = {Player, Seat, Amount} + }. + +cancel_timer(Data) -> + catch cardgame:cancel_timer(Data#data.timer). + +restart_timer(Data, Msg) -> + Timeout = gen_server:call(Data#data.game, 'TIMEOUT'), + Data#data { + timer = cardgame:start_timer(Timeout, Msg) + }. + +%%% +%%% Test suite +%%% + +modules() -> + %%[{delayed_start, [0]}, + %% {blinds, []}]. + [{blinds, []}]. + +make_game_heads_up() -> + Players = test:make_players(2), + Ctx = #texas { + small_blind_seat = none, + big_blind_seat = none, + button_seat = none + }, + Game = test:make_test_game(Players, Ctx, modules()), + {Game, Players}. + +make_game_3_bust() -> + Players = test:make_players(3), + Ctx = #texas { + small_blind_seat = element(2, lists:nth(2, Players)), + big_blind_seat = element(2, lists:nth(3, Players)), + button_seat = element(2, lists:nth(1, Players)) + }, + Game = test:make_test_game(Players, Ctx, modules()), + {Game, Players}. + +make_game_5_bust() -> + make_game_5_bust(1, 2, 3). + +make_game_5_bust(Button_N, SB_N, BB_N) -> + A = test:make_player('A'), + B = test:make_player('B'), + C = test:make_player('C'), + D = test:make_player('D'), + E = test:make_player('E'), + Players = [{A, 2}, {B, 4}, {C, 6}, {D, 8}, {E, 9}], + Ctx = #texas { + small_blind_seat = element(2, lists:nth(SB_N, Players)), + big_blind_seat = element(2, lists:nth(BB_N, Players)), + button_seat = element(2, lists:nth(Button_N, Players)) + }, + Game = test:make_test_game(10, Players, Ctx, modules()), + {Game, Players}. + +test() -> + test3(), + test4(), + test5(), + test6(), + test7(), + test8(), + test9(), + test10(), + test11(), + test12(), + ok. + +%% Both blinds are posted + +post_blinds_trigger(Game, Event, Pid) -> + case Event of + {in, {'$gen_cast', {?PP_BET_REQ, Game, Amount, 0, 0}}} -> + %% post the blind + cardgame:send_event(Game, {?PP_CALL, Pid, Amount}); + _ -> + ok + end, + Game. + +test3() -> + {Game, Players} = make_game_heads_up(), + [A, B] = Players, + test:install_trigger(fun post_blinds_trigger/3, Game, [A, B]), + Ctx = #texas { + button_seat = element(2, A), + small_blind_seat = element(2, A), + big_blind_seat = element(2, B), + call = 10 + }, + ?match(success, ?waitmsg({'CARDGAME EXIT', Game, Ctx}, 1000)), + cardgame:stop(Game), + test:kill_players(Players). + +%%% http://www.homepokertourney.com/button.htm + +%%% 3 players, button is bust + +test4() -> + {Game, Players} = make_game_3_bust(), + [A, B, C] = Players, + cardgame:cast(Game, {'SET STATE', element(1, A), ?PS_FOLD}), + test:install_trigger(fun post_blinds_trigger/3, Game, [A, B, C]), + Ctx = #texas { + button_seat = element(2, C), + small_blind_seat = element(2, C), + big_blind_seat = element(2, B), + call = 10 + }, + ?match(success, ?waitmsg({'CARDGAME EXIT', Game, Ctx}, 1000)), + cardgame:stop(Game), + test:kill_players(Players). + +%%% 3 players, small blind is bust + +test5() -> + {Game, Players} = make_game_3_bust(), + [A, B, C] = Players, + cardgame:cast(Game, {'SET STATE', element(1, B), ?PS_FOLD}), + test:install_trigger(fun post_blinds_trigger/3, Game, [A, B, C]), + Ctx = #texas { + button_seat = element(2, C), + small_blind_seat = element(2, C), + big_blind_seat = element(2, A), + call = 10 + }, + ?match(success, ?waitmsg({'CARDGAME EXIT', Game, Ctx}, 1000)), + cardgame:stop(Game), + test:kill_players(Players). + +%%% 3 players, big blind is bust + +test6() -> + {Game, Players} = make_game_3_bust(), + [A, B, C] = Players, + cardgame:cast(Game, {'SET STATE', element(1, C), ?PS_FOLD}), + test:install_trigger(fun post_blinds_trigger/3, Game, [A, B, C]), + Ctx = #texas { + button_seat = element(2, B), + small_blind_seat = element(2, B), + big_blind_seat = element(2, A), + call = 10 + }, + ?match(success, ?waitmsg({'CARDGAME EXIT', Game, Ctx}, 1000)), + cardgame:stop(Game), + test:kill_players(Players). + +%%% 5 players, small blind is bust + +test7() -> + {Game, Players} = make_game_5_bust(), + [_, B, C, D, E] = Players, + cardgame:cast(Game, {'SET STATE', element(1, B), ?PS_FOLD}), + test:install_trigger(fun post_blinds_trigger/3, Game, [B, C, D, E]), + Ctx = #texas { + button_seat = element(2, B), + small_blind_seat = element(2, C), + big_blind_seat = element(2, D), + call = 10 + }, + ?match(success, ?waitmsg({'CARDGAME EXIT', Game, Ctx}, 1000)), + cardgame:stop(Game), + test:kill_players(Players). + +test8() -> + {Game, Players} = make_game_5_bust(2, 3, 4), + [_, B, C, D, E] = Players, + cardgame:cast(Game, {'SET STATE', element(1, B), ?PS_FOLD}), + test:install_trigger(fun post_blinds_trigger/3, Game, [B, C, D, E]), + Ctx = #texas { + button_seat = element(2, C), + small_blind_seat = element(2, D), + big_blind_seat = element(2, E), + call = 10 + }, + ?match(success, ?waitmsg({'CARDGAME EXIT', Game, Ctx}, 1000)), + cardgame:stop(Game), + test:kill_players(Players). + +%%% 5 players, big blind is bust + +test9() -> + {Game, Players} = make_game_5_bust(), + [_, B, C, D, E] = Players, + cardgame:cast(Game, {'SET STATE', element(1, C), ?PS_FOLD}), + test:install_trigger(fun post_blinds_trigger/3, Game, [B, C, D, E]), + Ctx = #texas { + button_seat = element(2, B), + small_blind_seat = element(2, C), + big_blind_seat = element(2, D), + call = 10 + }, + ?match(success, ?waitmsg({'CARDGAME EXIT', Game, Ctx}, 1000)), + cardgame:stop(Game), + test:kill_players(Players). + +test10() -> + {Game, Players} = make_game_5_bust(2, 3, 4), + [_, B, C, D, E] = Players, + cardgame:cast(Game, {'SET STATE', element(1, C), ?PS_FOLD}), + test:install_trigger(fun post_blinds_trigger/3, Game, [B, C, D, E]), + Ctx = #texas { + button_seat = element(2, C), + small_blind_seat = element(2, D), + big_blind_seat = element(2, E), + call = 10 + }, + ?match(success, ?waitmsg({'CARDGAME EXIT', Game, Ctx}, 1000)), + cardgame:stop(Game), + test:kill_players(Players). + +%%% 5 players, both blinds are bust + +test11() -> + {Game, Players} = make_game_5_bust(), + [_, B, C, D, E] = Players, + cardgame:cast(Game, {'SET STATE', element(1, B), ?PS_FOLD}), + cardgame:cast(Game, {'SET STATE', element(1, C), ?PS_FOLD}), + test:install_trigger(fun post_blinds_trigger/3, Game, [B, C, D, E]), + Ctx = #texas { + button_seat = element(2, B), + small_blind_seat = element(2, C), + big_blind_seat = element(2, D), + call = 10 + }, + ?match(success, ?waitmsg({'CARDGAME EXIT', Game, Ctx}, 1000)), + cardgame:stop(Game), + test:kill_players(Players). + +test12() -> + {Game, Players} = make_game_5_bust(2, 3, 4), + [_, B, C, D, E] = Players, + cardgame:cast(Game, {'SET STATE', element(1, B), ?PS_FOLD}), + cardgame:cast(Game, {'SET STATE', element(1, C), ?PS_FOLD}), + test:install_trigger(fun post_blinds_trigger/3, Game, [B, C, D, E]), + Ctx = #texas { + button_seat = element(2, C), + small_blind_seat = element(2, D), + big_blind_seat = element(2, E), + call = 10 + }, + ?match(success, ?waitmsg({'CARDGAME EXIT', Game, Ctx}, 1000)), + cardgame:stop(Game), + test:kill_players(Players). + diff --git a/openpoker-server/src/bot.erl b/openpoker-server/src/bot.erl new file mode 100644 index 0000000..4ffae26 --- /dev/null +++ b/openpoker-server/src/bot.erl @@ -0,0 +1,384 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(bot). +-behaviour(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). + +-export([start/4, stop/1]). + +-include("test.hrl"). +-include("common.hrl"). +-include("proto.hrl"). + +-record(bot, { + nick, + player, + game, + socket, + actions, + balance, + seat_num, + irc_game_id, + done + }). + +new(IRC_ID, Nick, SeatNum, Balance) -> + Bot = #bot { + nick = Nick, + player = none, + game = none, + balance = Balance, + socket = none, + actions = [], + seat_num = SeatNum, + irc_game_id = IRC_ID, + done = false + }, + Bot. + +start(Nick, IRC_ID, SeatNum, Balance) -> + gen_server:start(bot, [Nick, IRC_ID, SeatNum, Balance], []). + +init([Nick, IRC_ID, SeatNum, Balance]) -> + process_flag(trap_exit, true), + {ok, new(Nick, IRC_ID, SeatNum, Balance)}. + +stop(Ref) -> + gen_server:cast(Ref, stop). + +terminate(_Reason, Bot) -> + case Bot#bot.socket of + none -> + ignore; + Socket -> + if + not Bot#bot.done -> + error_logger:warning_report([{message, "Premature connection close"}, + {module, ?MODULE}, + {line, ?LINE}, + {bot, Bot}]); + true -> + ok + end, + gen_tcp:close(Socket) + end, + ok. + +handle_cast({'SET ACTIONS', Actions}, Bot) -> + Bot1 = Bot#bot { + actions = Actions + }, + {noreply, Bot1}; + +handle_cast(stop, Bot) -> + {stop, normal, Bot}; + +handle_cast(Event, Bot) -> + ok = ?tcpsend(Bot#bot.socket, Event), + {noreply, Bot}. + +handle_call({'CONNECT', Host, Port}, _From, Bot) -> + {ok, Sock} = tcp_server:start_client(Host, Port, 1024), + Bot1 = Bot#bot { + socket = Sock + }, + {reply, ok, Bot1}; + +handle_call('ACTIONS', _From, Bot) -> + {reply, Bot#bot.actions, Bot}; + +handle_call('SOCKET', _From, Bot) -> + {reply, Bot#bot.socket, Bot}; + +handle_call(Event, From, Bot) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {from, From}, + {message, Event}]), + {noreply, Bot}. + +handle_info({tcp_closed, Socket}, Bot) -> + if + not Bot#bot.done -> + error_logger:warning_report([{message, "Premature connection close"}, + {module, ?MODULE}, + {line, ?LINE}, + {socket, Socket}, + {bot, Bot}]); + true -> + ok + end, + {stop, normal, Bot}; + +handle_info({tcp, _Socket, Bin}, Bot) -> + case proto:read(Bin) of + none -> + {noreply, Bot}; + Event -> + handle(Event, Bot) + end; + +handle_info({'EXIT', _Pid, _Reason}, Bot) -> + %% child exit? + {noreply, Bot}; + +handle_info(Info, Bot) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Info}]), + {noreply, Bot}. + +code_change(_OldVsn, Bot, _Extra) -> + {ok, Bot}. + +handle({?PP_PID, PID}, Bot) -> + Bot1 = Bot#bot { + player = PID + }, + {noreply, Bot1}; + +handle({?PP_GAME_INFO, _GID, ?GT_IRC_TEXAS, + _Expected, _Joined, _Waiting, + {?LT_FIXED_LIMIT, _Low, _High}}, Bot) -> + {noreply, Bot}; + +handle({?PP_PLAYER_INFO, _PID, _InPlay, _Nick, _Location}, Bot) -> + {noreply, Bot}; + +handle({?PP_NOTIFY_JOIN, GID, PID, _SeatNum, _Seq}, Bot) -> + Bot1 = if + PID == Bot#bot.player -> + Bot#bot { + game = GID + }; + true -> + Bot + end, + {noreply, Bot1}; + +handle({?PP_NOTIFY_CHAT, _GID, _PID, _Seq, _Message}, Bot) -> + {noreply, Bot}; + +handle({?PP_BET_REQ, GID, Amount}, Bot) -> + GID = Bot#bot.game, + %%io:format("~w: BLIND_REQ: ~w/~w, ~.2. f~n", + %% [GID, Bot#bot.player, Bot#bot.seat_num, Amount]), + [Action|Rest] = Bot#bot.actions, + Bot1 = Bot#bot { + actions = Rest + }, + case Action of + 'SIT OUT' -> + handle_cast({?PP_SIT_OUT, Bot1#bot.game}, Bot1), + {noreply, Bot1}; + 'BLIND' -> + handle_cast({?PP_CALL, Bot1#bot.game, Amount}, Bot1), + Bot2 = Bot1#bot { + balance = Bot1#bot.balance - Amount + }, + {noreply, Bot2}; + {'BLIND', allin} -> + handle_cast({?PP_CALL, Bot1#bot.game, Bot1#bot.balance}, Bot1), + Bot2 = Bot1#bot { + balance = 0 + }, + {noreply, Bot2}; + 'FOLD' -> + handle_cast({?PP_FOLD, Bot1#bot.game}, Bot1), + {noreply, Bot1}; + _ -> + error_logger:error_report([{message, "Unexpected blind request, folding!"}, + {module, ?MODULE}, + {line, ?LINE}, + {bot, Bot1}, + {amount, Amount}, + {now, now()}]), + handle_cast({?PP_FOLD, Bot1#bot.game}, Bot1), + {noreply, Bot1} + end; + +handle({?PP_BET_REQ, GID, Call, RaiseMin, RaiseMax}, Bot) -> + GID = Bot#bot.game, + [Action|Rest] = Bot#bot.actions, + Bot1 = Bot#bot { + actions = Rest + }, + %%io:format("#~w/~w: BET_REQ ~.2. f/~.2. f/~.2. f~n", + %% [Bot#bot.player, Bot#bot.seat_num, Call, RaiseMin, RaiseMax]), + %%io:format("#~w/~w: Actions: ~w~n", + %% [Bot#bot.player, Bot#bot.seat_num, Bot#bot.actions]), + %%io:format("#~w/~w: Balance: ~.2. f~n", + %% [Bot#bot.player, Bot#bot.seat_num, Bot#bot.balance * 1.0]), + case Action of + 'SIT OUT' -> + handle_cast({?PP_SIT_OUT, Bot1#bot.game}, Bot1), + {noreply, Bot1}; + 'BLIND' -> + handle_cast({?PP_CALL, Bot1#bot.game, Call}, Bot1), + Bot2 = Bot1#bot { + balance = Bot1#bot.balance - Call + }, + {noreply, Bot2}; + {'BLIND', allin} -> + handle_cast({?PP_CALL, Bot1#bot.game, Bot1#bot.balance}, Bot1), + Bot2 = Bot1#bot { + balance = 0 + }, + {noreply, Bot2}; + 'CHECK' -> + handle_cast({?PP_CALL, Bot1#bot.game, 0}, Bot1), + {noreply, Bot1}; + 'CALL' -> + handle_cast({?PP_CALL, Bot1#bot.game, Call}, Bot1), + Bot2 = Bot1#bot { + balance = Bot1#bot.balance - Call + }, + {noreply, Bot2}; + {'CALL', allin} -> + handle_cast({?PP_CALL, Bot1#bot.game, Bot1#bot.balance}, Bot1), + Bot2 = Bot1#bot { + balance = 0 + }, + {noreply, Bot2}; + 'RAISE' -> + handle_cast({?PP_RAISE, Bot1#bot.game, RaiseMin}, Bot1), + Bot2 = Bot1#bot { + balance = Bot1#bot.balance - Call - RaiseMin + }, + {noreply, Bot2}; + {'RAISE', allin} -> + handle_cast({?PP_RAISE, Bot1#bot.game, Bot1#bot.balance - Call}, Bot1), + Bot2 = Bot1#bot { + balance = 0 + }, + {noreply, Bot2}; + 'BET' -> + handle_cast({?PP_RAISE, Bot1#bot.game, RaiseMin}, Bot1), + Bot2 = Bot1#bot { + balance = Bot1#bot.balance - RaiseMin + }, + {noreply, Bot2}; + {'BET', allin} -> + handle_cast({?PP_RAISE, Bot1#bot.game, Bot1#bot.balance - Call}, Bot1), + Bot2 = Bot1#bot { + balance = 0 + }, + {noreply, Bot2}; + 'FOLD' -> + handle_cast({?PP_FOLD, Bot1#bot.game}, Bot1), + {noreply, Bot1}; + 'QUIT' -> + handle_cast({?PP_FOLD, Bot1#bot.game}, Bot1), + {noreply, Bot1}; + _ -> + error_logger:error_report([{message, "Unexpected bet request, folding!"}, + {module, ?MODULE}, + {line, ?LINE}, + {bot, Bot1}, + {call, Call}, + {raise_min, RaiseMin}, + {raise_max, RaiseMax}, + {now, now()}]), + handle_cast({?PP_FOLD, Bot1#bot.game}, Bot1), + {noreply, Bot1} + end; + +handle({?PP_PLAYER_STATE, _GID, _PID, _State, _Seq}, Bot) -> + {noreply, Bot}; + +handle({?PP_NOTIFY_LEAVE, _GID, PID, _Seq}, Bot) -> + if + PID == Bot#bot.player -> + ok = ?tcpsend(Bot#bot.socket, ?PP_LOGOUT), + {stop, leave, Bot}; + true -> + {noreply, Bot} + end; + +handle({?PP_GAME_STAGE, _GID, _Stage, _Seq}, Bot) -> + {noreply, Bot}; + +handle({?PP_NOTIFY_START_GAME, _GID, _Seq}, Bot) -> + {noreply, Bot}; + +handle({?PP_NOTIFY_END_GAME, GID, _Seq}, Bot) -> + %%io:format("Bot ~w leaving ~w at ~w~n", + %% [Bot#bot.player, GID, now()]), + ok = ?tcpsend(Bot#bot.socket, {?PP_LEAVE, GID}), + ok = ?tcpsend(Bot#bot.socket, ?PP_LOGOUT), + Bot1 = Bot#bot { + done = true + }, + {stop, normal, Bot1}; + +handle({?PP_NOTIFY_CANCEL_GAME, GID, _Seq}, Bot) -> + ok = ?tcpsend(Bot#bot.socket, {?PP_JOIN, GID, + Bot#bot.seat_num, + Bot#bot.balance}), + {noreply, Bot}; + +handle({Cmd, _GID, _PID, _Amount, _Seq}, Bot) + when Cmd == ?PP_NOTIFY_WIN; + Cmd == ?PP_NOTIFY_CALL; + Cmd == ?PP_NOTIFY_RAISE; + Cmd == ?PP_NOTIFY_BET -> + {noreply, Bot}; + +handle({?PP_NOTIFY_DRAW, _GID, _Card, _Seq}, Bot) -> + {noreply, Bot}; + +handle({?PP_NOTIFY_PRIVATE, _GID, _PID, _Seq}, Bot) -> + {noreply, Bot}; + +handle({?PP_NOTIFY_BUTTON, _GID, _SeatNum, _Seq}, Bot) -> + {noreply, Bot}; + +handle({?PP_NOTIFY_SB, _GID, _SeatNum, _Seq}, Bot) -> + {noreply, Bot}; + +handle({?PP_NOTIFY_BB, _GID, _SeatNum, _Seq}, Bot) -> + {noreply, Bot}; + +handle({?PP_GOOD, _, _}, Bot) -> + {noreply, Bot}; + +handle({Cmd, _GID, {_Face, _Suit}, _Seq}, Bot) + when Cmd == ?PP_NOTIFY_DRAW; + Cmd == ?PP_NOTIFY_SHARED -> + {noreply, Bot}; + +%% Sink + +handle(Event, Bot) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {event, Event}]), + {noreply, Bot}. + + + + diff --git a/openpoker-server/src/cardgame.erl b/openpoker-server/src/cardgame.erl new file mode 100644 index 0000000..d9d9148 --- /dev/null +++ b/openpoker-server/src/cardgame.erl @@ -0,0 +1,579 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(cardgame). +-behavior(gen_fsm). + +%% behaviour modules must export this function + +-export([behaviour_info/1]). + +%% export the gen_fsm interface + +-export([start/3, start/5, test_start/5, + send_event/2, sync_send_event/2, sync_send_event/3, + send_all_state_event/2, sync_send_all_state_event/2, + sync_send_all_state_event/3, reply/2, send_event_after/2, + start_timer/2, cancel_timer/1]). + +%% export the gen_fsm state handler call backs + +-export([restart/1, stop/1, dispatch/2, dispatch/3]). + +%% export the gen_fsm common call backs + +-export([init/1, handle_event/3, handle_sync_event/4, + handle_info/3, terminate/3, code_change/4]). + +%% our stuff + +-export([call/2, cast/2, test/0]). + +-include("proto.hrl"). +-include("texas.hrl"). +-include("common.hrl"). + +%% define what callbacks users must export + +behaviour_info(callbacks) -> + gen_fsm:behaviour_info(callbacks); + +behaviour_info(Other) -> + gen_fsm:behaviour_info(Other). + +%% State data + +-record(data, { + game, + modules, + stack, + state, + statedata, + parent, + context, + original_context + }). + +start(GameType, SeatCount, LimitType) -> + start(GameType, SeatCount, LimitType, ?START_DELAY, ?PLAYER_TIMEOUT). + +start(GameType, SeatCount, LimitType, Delay, Timeout) -> + %% create game stack. context is used to propagate + %% game information from module to module, e.g. button + %% and blinds position for texas hold'em + case GameType of + ?GT_IRC_TEXAS -> + %% irc texas differs slightly in application of button + %% rules as well as the number of raises allowed + Modules = [ + %% start delay + {delayed_start, [Delay]}, + %% irc blind rules + {blinds, [irc]}, + %% deal 2 cards to each player + {deal_cards, [2, private]}, + %% start after BB, 100 raises + {betting, [100, ?GS_PREFLOP, true]}, + %% show 3 shared cards + {deal_cards, [3, shared]}, + %% flop + {betting, [100, ?GS_FLOP]}, + %% show 1 more shared card + {deal_cards, [1, shared]}, + %% turn + {betting, [100, ?GS_TURN]}, + %% show 1 more shared card + {deal_cards, [1, shared]}, + %% river + {betting, [100, ?GS_RIVER]}, + %% showdown + {showdown, []} + ], + Context = #texas{}; + ?GT_TEXAS_HOLDEM -> + Modules = [ + %% start delay + {delayed_start, [Delay]}, + %% blind rules + {blinds, []}, + %% deal 2 cards to each player + {deal_cards, [2, private]}, + %% start after BB, 3 raises + {betting, [?MAX_RAISES, ?GS_PREFLOP, true]}, + %% show 3 shared cards + {deal_cards, [3, shared]}, + %% flop + {betting, [?MAX_RAISES, ?GS_FLOP]}, + %% show 1 more shared card + {deal_cards, [1, shared]}, + %% turn + {betting, [?MAX_RAISES, ?GS_TURN]}, + %% show 1 more shared card + {deal_cards, [1, shared]}, + %% river + {betting, [?MAX_RAISES, ?GS_RIVER]}, + %% showdown + {showdown, []} + ], + Context = #texas{} + end, + %% start the cardgame finite state machine + case gen_fsm:start(?MODULE, [self(), GameType, SeatCount, LimitType, + Context, Modules], []) of + {ok, Pid} = X -> + cardgame:cast(Pid, {'TIMEOUT', Timeout}), + X; + Any -> + Any + end. + +test_start(GameType, SeatCount, Limit, Context, Modules) -> + gen_fsm:start(?MODULE, [self(), GameType, SeatCount, Limit, + Context, Modules], []). +%% +%% The gen_fsm API functions +%% + +send_event(FsmRef, Event) -> + gen_fsm:send_event(FsmRef, Event). + +sync_send_event(FsmRef, Event) -> + gen_fsm:sync_send_event(FsmRef, Event). + +sync_send_event(FsmRef, Event, Timeout) -> + gen_fsm:sync_send_event(FsmRef, Event, Timeout). + +send_all_state_event(FsmRef, Event) -> + gen_fsm:send_all_state_event(FsmRef, Event). + +sync_send_all_state_event(FsmRef, Event) -> + gen_fsm:sync_send_all_state_event(FsmRef, Event). + +sync_send_all_state_event(FsmRef, Event, Timeout) -> + gen_fsm:sync_send_all_state_event(FsmRef, Event, Timeout). + +reply(Caller, Reply) -> + gen_fsm:reply(Caller, Reply). + +send_event_after(Time, Event) -> + gen_fsm:send_event_after(Time, Event). + +start_timer(Time, Msg) -> + gen_fsm:start_timer(Time, Msg). + +cancel_timer(Ref) -> + gen_fsm:cancel_timer(Ref). + +%% +%% The gen_fsm call backs +%% + +init([Parent, GameType, SeatCount, LimitType, Context, Modules]) + when is_pid(Parent), + is_number(SeatCount), + is_tuple(LimitType), + is_tuple(Context), + is_list(Modules) -> + process_flag(trap_exit, true), + {Module, Args} = hd(Modules), + {ok, Game} = game:start(self(), GameType, SeatCount, LimitType), + Ctx = #data { + parent = Parent, + game = Game, + modules = Modules, + stack = Modules, + context = Context, + original_context = Context + }, + case Module:init([Game|Args]) of + {ok, State, Data} -> + Ctx1 = Ctx#data { + state = State, + statedata = Data + }, + send_event_after(0, {'START', Context}), + {ok, dispatch, Ctx1}; + + {ok, State, Data, Timeout} -> + Ctx1 = Ctx#data { + state = State, + statedata = Data + }, + send_event_after(0, {'START', Context}), + {ok, dispatch, Ctx1, Timeout}; + + {stop, Reason} -> + game:stop(Game), + {stop, Reason}; + + ignore -> + ignore; + + Other -> + Other + end. + +dispatch('SHOWDOWN', Ctx) -> + {next_stage, dispatch, Ctx}; + +dispatch(Event, Ctx) -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + case Module:State(Event, Ctx#data.statedata) of + {next_state, NextState, NewData} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {next_state, dispatch, NewCtx}; + + {next_state, NextState, NewData, Timeout} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {next_state, dispatch, NewCtx, Timeout}; + + {stop, Reason, NewData} -> + stop(Ctx, Reason, NewData); + + Other -> + Other + end. + +dispatch(Event, From, Ctx) -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + case Module:State(Event, From, Ctx#data.statedata) of + {reply, Reply, NextState, NewData} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {reply, Reply, dispatch, NewCtx}; + + {reply, Reply, NextState, NewData, Timeout} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {reply, Reply, dispatch, NewCtx, Timeout}; + + {next_state, NextState, NewData} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {next_state, dispatch, NewCtx}; + + {next_state, NextState, NewData, Timeout} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {next_state, dispatch, NewCtx, Timeout}; + + {stop, Reason, Reply, NewData} -> + NewCtx = Ctx#data { + statedata = NewData + }, + {stop, Reason, Reply, NewCtx}; + + {stop, Reason, NewData} -> + stop(Ctx, Reason, NewData); + + Other -> + Other + end. + +handle_event('RESTART', dispatch, Ctx) -> + start_next_module(Ctx, Ctx#data.modules); + +%% intercept rigging of the deck to reset our context. +%% this is needed so that the button in irc texas games +%% starts from seat #1. + +handle_event({'CAST', Event = {'RIG', _}}, dispatch, Ctx) -> + Ctx1 = Ctx#data { + context = Ctx#data.original_context + }, + gen_server:cast(Ctx1#data.game, Event), + {next_state, dispatch, Ctx1}; + +handle_event({'CAST', Event}, dispatch, Ctx) -> + gen_server:cast(Ctx#data.game, Event), + {next_state, dispatch, Ctx}; + +handle_event(Event, dispatch, Ctx) -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + Data = Ctx#data.statedata, + case Module:handle_event(Event, State, Data) of + {next_state, NextState, NewData} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {next_state, dispatch, NewCtx}; + + {next_state, NextState, NewData, Timeout} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {next_state, dispatch, NewCtx, Timeout}; + + {stop, Reason, NewData} -> + stop(Ctx, Reason, NewData); + + Other -> + Other + end. + +handle_sync_event({'CALL', Event}, _From, dispatch, Ctx) -> + Reply = gen_server:call(Ctx#data.game, Event), + {reply, Reply, dispatch, Ctx}; + +handle_sync_event(Event, From, dispatch, Ctx) -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + case Module:handle_sync_event(Event, From, State, Ctx#data.statedata) of + {reply, Reply, NextState, NewData} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {reply, Reply, dispatch, NewCtx}; + + {reply, Reply, NextState, NewData, Timeout} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {reply, Reply, dispatch, NewCtx, Timeout}; + + {next_state, NextState, NewData} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {next_state, dispatch, NewCtx}; + + {next_state, NextState, NewData, Timeout} -> + NewCtx = Ctx#data{ + state = NextState, + statedata = NewData + }, + {next_state, dispatch, NewCtx, Timeout}; + + {stop, Reason, Reply, NewData} -> + NewCtx = Ctx#data { + statedata = NewData + }, + {stop, Reason, Reply, NewCtx}; + + {stop, Reason, NewData} -> + stop(Ctx, Reason, NewData); + + Other -> + Other + end. + +handle_info(stop, dispatch, Ctx) -> + stop(Ctx, {normal, exit}, none); + +handle_info(Event, dispatch, Ctx) -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + case Module:handle_info(Event, State, Ctx#data.statedata) of + {next_state, NextState, NewData} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData}, + {next_state, dispatch, NewCtx}; + + {next_state, NextState, NewData, Timeout} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {next_state, dispatch, NewCtx, Timeout}; + + {stop, Reason, NewData} -> + stop(Ctx, Reason, NewData); + + Other -> + Other + end. + +terminate(Reason, dispatch, Ctx) -> + GID = gen_server:call(Ctx#data.game, 'ID'), + db:delete(game_xref, GID), + game:stop(Ctx#data.game), + if + Ctx#data.stack /= [] -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + Data = Ctx#data.statedata, + Module:terminate(Reason, State, Data); + true -> + ok + end. + +code_change(OldVersion, dispatch, Ctx, Extra) -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + Data = Ctx#data.statedata, + case Module:code_change(OldVersion, State, Data, Extra) of + {ok, NextState, NewData} -> + NewCtx = Ctx#data { + state = NextState, + statedata = NewData + }, + {ok, dispatch, NewCtx}; + + Other -> + Other + end. + +%% stop card game + +stop(Ctx, shutdown, Data) -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + Module:terminate(shutdown, State, Data), + stop(Ctx, normal, Data); + +stop(Ctx, {normal, exit}, Data) -> + %% send to parent + Ctx#data.parent ! {'CARDGAME EXIT', self(), exit}, + stop(Ctx, normal, Data); + +%% terminate current module +%% and restart at the top + +stop(Ctx, {normal, restart}, Data) -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + Module:terminate({normal, restart}, State, Data), + start_next_module(Ctx, Ctx#data.modules); + +%% terminate current module +%% and restart at the top +%% carrying over the result + +stop(Ctx, {normal, restart, Result}, Data) -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + Module:terminate({normal, restart}, State, Data), + Ctx1 = Ctx#data { + context = Result + }, + start_next_module(Ctx1, Ctx#data.modules); + +%% terminate current module +%% and start the next one + +stop(Ctx, {normal, Result}, Data) -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + Module:terminate({normal, Result}, State, Data), + [_|Stack] = Ctx#data.stack, + Ctx1 = Ctx#data { + context = Result + }, + start_next_module(Ctx1, Stack); + +%% terminate current module +%% and start the very last one + +stop(Ctx, {endgame, Result}, Data) -> + {Module, _} = hd(Ctx#data.stack), + State = Ctx#data.state, + Module:terminate({normal, Result}, State, Data), + Stack = [lists:last(Ctx#data.stack)], + Ctx1 = Ctx#data { + context = Result + }, + start_next_module(Ctx1, Stack); + +%% stop cardgame + +stop(Ctx, Reason, Data) -> + NewCtx = Ctx#data { + statedata = Data + }, + {stop, Reason, NewCtx}. + +start_next_module(Ctx, []) -> + %% module stack is empty, + %% send result to parent + Ctx#data.parent ! {'CARDGAME EXIT', self(), Ctx#data.context}, + {stop, normal, Ctx}; + +%% initialize next gen_fsm callback module + +start_next_module(Ctx, Modules) -> + {Module, Args} = hd(Modules), + case Module:init([Ctx#data.game|Args]) of + {ok, State, Data} -> + NewCtx = Ctx#data { + stack = Modules, + state = State, + statedata = Data + }, + send_event_after(0, {'START', Ctx#data.context}), + {next_state, dispatch, NewCtx}; + + {ok, State, Data, Timeout} -> + NewCtx = Ctx#data { + game = game:start(), + stack = Modules, + state = State, + statedata = Data + }, + send_event_after(0, {'START', Ctx#data.context}), + {next_state, dispatch, NewCtx, Timeout}; + + {stop, Reason} -> + {stop, Reason, Ctx}; + + ignore -> + ignore; + + Other -> + Other + end. + +stop(CardGameRef) -> + gen_fsm:send_all_state_event(CardGameRef, stop). + +restart(CardGameRef) -> + gen_fsm:sync_send_all_state_event(CardGameRef, 'RESTART'). + +call(CardGameRef, Event) -> + gen_fsm:sync_send_all_state_event(CardGameRef, {'CALL', Event}). + +cast(CardGameRef, Event) -> + gen_fsm:send_all_state_event(CardGameRef, {'CAST', Event}). + +test() -> + ok. diff --git a/openpoker-server/src/common.hrl b/openpoker-server/src/common.hrl new file mode 100644 index 0000000..159c8fc --- /dev/null +++ b/openpoker-server/src/common.hrl @@ -0,0 +1,31 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +%%% + +-define(PLAYER_TIMEOUT, 15000). +-define(START_DELAY, 10000). +-define(MAX_RAISES, 3). +-define(MAX_PLAYERS, 500000). + +%%% + +-define(GAME_SERVERS, 'GAME SERVERS'). diff --git a/openpoker-server/src/counter.erl b/openpoker-server/src/counter.erl new file mode 100644 index 0000000..0d446ea --- /dev/null +++ b/openpoker-server/src/counter.erl @@ -0,0 +1,41 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(counter). + +-export([bump/1, bump/2, reset/1]). + +-include("schema.hrl"). + +bump(Type) -> + bump(Type, 1). + +bump(Type, Inc) -> + mnesia:dirty_update_counter(counter, Type, Inc). + +reset(Type) -> + Counter = #counter { + type = Type, + value = 0 + }, + mnesia:transaction(fun() -> + mnesia:write(Counter) + end). diff --git a/openpoker-server/src/db.erl b/openpoker-server/src/db.erl new file mode 100644 index 0000000..d1545dc --- /dev/null +++ b/openpoker-server/src/db.erl @@ -0,0 +1,324 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(db). + +-export([test/0, set/3, get/3, inc/3, dec/3, move_amt/3]). +-export([delete/1, delete/2, find/1, find/2, find/3]). + +-include("test.hrl"). +-include("schema.hrl"). + +%%% Find the position of an atom in a list + +fieldnum(Field, []) + when is_atom(Field) -> + none; + +fieldnum(Field, Fields) + when is_atom(Field), + is_list(Fields) -> + fieldnum(Field, Fields, 1). + +fieldnum(_Field, [], _N) -> + none; + +fieldnum(Field, [H|T], N) -> + if + Field == H -> + N; + true -> + fieldnum(Field, T, N + 1) + end. + +%%% Update Field in Table with Value +%%% using Key to lookup the record. +%%% Fun is fun(OldFieldValue, Value) +%%% and should return the new value +%%% of the field or the tupe {error, reason}. + +set(Table, Key, {Field, Value}, Fun) + when is_atom(Table), + is_atom(Field) -> + Fields = mnesia:table_info(Table, attributes), + case fieldnum(Field, Fields) of + none -> + {atomic, {error, field_not_found}}; + N -> + F = fun() -> + case mnesia:read({Table, Key}) of + [] -> + {error, key_not_found}; + [Data] -> + case Fun(element(N + 1, Data), Value) of + {error, Reason} -> + {error, Reason}; + Value1 -> + Data1 = setelement(N + 1, + Data, + Value1), + mnesia:write(Data1) + end; + Any -> + Any + end + end, + mnesia:transaction(F) + end. + +set(Table, Key, {Field, _Value} = V) + when is_atom(Table), + is_atom(Field) -> + F = fun(_Old, New) -> New end, + set(Table, Key, V, F); + +%%% Simple set using a list of fields and values + +set(Table, Key, Values) + when is_atom(Table), + is_list(Values) -> + Fields = mnesia:table_info(Table, attributes), + case find(Table, Key) of + {atomic, [Data]} -> + set(Data, Fields, Values); + Any -> + Any + end; + +set(Data, _Fields, []) -> + mnesia:transaction(fun() -> + mnesia:write(Data) + end); + +set(Data, Fields, [{Field, Value}|Rest]) + when is_tuple(Data), + is_list(Fields), + is_atom(Field) -> + case fieldnum(Field, Fields) of + none -> + {atomic, {error, field_not_found}}; + N -> + Data1 = setelement(N + 1, + Data, + Value), + set(Data1, Fields, Rest) + end. + +%%% Retrieve value in Table +%%% using Key to lookup the record. + +get(Table, Key, Field) + when is_atom(Table), + is_atom(Field) -> + Fields = mnesia:table_info(Table, attributes), + case fieldnum(Field, Fields) of + none -> + {atomic, {error, field_not_found}}; + N -> + F = fun() -> + case mnesia:read({Table, Key}) of + [] -> + {error, key_not_found}; + [Data] -> + element(N + 1, Data); + Any -> + Any + end + end, + mnesia:transaction(F) + end. + + +dec(Table, Key, Field) + when is_atom(Table), + is_tuple(Field) -> + F = fun(Balance, Amount) -> + if + Amount > Balance -> + {error, out_of_balance}; + true -> + Balance - Amount + end + end, + set(Table, Key, Field, F). + +inc(Table, Key, Field) + when is_atom(Table), + is_tuple(Field) -> + F = fun(Balance, Amount) -> Balance + Amount end, + set(Table, Key, Field, F). + +move_amt(Table, Key, {From, To, Value}) + when is_atom(Table), + is_atom(From), + is_atom(To), + is_number(Value) -> + Fields = mnesia:table_info(Table, attributes), + FromN = fieldnum(From, Fields), + ToN = fieldnum(To, Fields), + F = fun() -> + case mnesia:read({Table, Key}) of + [] -> + {error, key_not_found}; + [Data] -> + FromVal = element(FromN + 1, Data), + ToVal = element(ToN + 1, Data), + if + FromVal - Value < 0 -> + {error, out_of_balance}; + true -> + Data1 = setelement(FromN + 1, + Data, + FromVal - Value), + Data2 = setelement(ToN + 1, + Data1, + ToVal + Value), + mnesia:write(Data2) + end; + Any -> + Any + end + end, + if + (FromN == none) or (ToN == none) -> + {atomic, {error, field_not_found}}; + true -> + mnesia:transaction(F) + end. + +delete(Table) + when is_atom(Table) -> + mnesia:clear_table(Table). + +delete(Table, KeyVal) + when is_atom(Table) -> + F = fun() -> mnesia:delete({Table, KeyVal}) end, + mnesia:transaction(F). + +%%% Make a {table_name, '_', ...} pattern +%%% to match and retrieve all table rows. + +makepat(Table) + when is_atom(Table) -> + Fields = mnesia:table_info(Table, attributes), + makepat(Fields, [Table]). + +makepat([], Acc) -> + list_to_tuple(lists:reverse(Acc)); + +makepat([_H|T], Acc) -> + makepat(T, ['_'|Acc]). + +find(Table) + when is_atom(Table) -> + Pat = makepat(Table), + F = fun() -> mnesia:match_object(Pat) end, + mnesia:transaction(F). + +%%% Lookup using primary key value + +find(Table, KeyVal) + when is_atom(Table) -> + F = fun() -> mnesia:read({Table, KeyVal}) end, + mnesia:transaction(F). + +%%% Lookup using a secondary index + +find(Table, Field, Value) + when is_atom(Table), + is_atom(Field) -> + Fields = mnesia:table_info(Table, attributes), + case fieldnum(Field, Fields) of + none -> + {atomic, {error, field_not_found}}; + N -> + F = fun() -> + mnesia:index_read(Table, Value, N + 1) + end, + mnesia:transaction(F) + end. + +%%% +%%% Test harness +%%% + +test() -> + test1(), + test2(), + test3(), + ok. + +test1() -> + ?match(none, fieldnum(foo, [])), + ?match(none, fieldnum(foo, [bar, baz])), + ?match(1, fieldnum(foo, [foo, bar, baz])), + ?match(3, fieldnum(baz, [foo, bar, baz])). + +test2() -> + ?match({game_xref, '_', '_', '_', '_'}, + makepat(game_xref)). + +test3() -> + Config = #cluster_config { + id = 1, + max_login_errors = 0 + }, + F = fun() -> mnesia:write(Config) end, + {atomic, ok} = mnesia:transaction(F), + %% bad table name + Result1 = (catch set(foo, 1, {max_login_errors, 3})), + ?match({'EXIT',{aborted,{no_exists,foo,attributes}}}, Result1), + %% bad key value + Result2 = set(cluster_config, 2, {max_login_errors, 3}), + ?match({atomic, {error, key_not_found}}, Result2), + %% bad field name + Result3 = set(cluster_config, 1, {foo, 3}), + ?match({atomic, {error, field_not_found}}, Result3), + %% error + Fun1 = fun(_, _) -> {error, balance} end, + Result4 = set(cluster_config, 1, {max_login_errors, 3}, Fun1), + ?match({atomic, {error, balance}}, Result4), + %% should work + Result5 = set(cluster_config, 1, {max_login_errors, 3}), + ?match({atomic, ok}, Result5), + ?match({atomic, 3}, get(cluster_config, 1, max_login_errors)), + %% bump it up + Result6 = inc(cluster_config, 1, {max_login_errors, 4}), + ?match({atomic, ok}, Result6), + ?match({atomic, 7}, get(cluster_config, 1, max_login_errors)), + %% bump it down + Result7 = dec(cluster_config, 1, {max_login_errors, 3}), + ?match({atomic, ok}, Result7), + ?match({atomic, 4}, get(cluster_config, 1, max_login_errors)), + %% list of field values + {atomic, ok} = set(cluster_config, 1, + [{logdir, "/tmp/foo"}, + {max_login_errors, 10}]), + ?match({atomic, "/tmp/foo"}, get(cluster_config, 1, logdir)), + ?match({atomic, 10}, get(cluster_config, 1, max_login_errors)), + %% clean up + ?match({atomic, ok}, delete(cluster_config, 1)). + + + + + + diff --git a/openpoker-server/src/deal_cards.erl b/openpoker-server/src/deal_cards.erl new file mode 100644 index 0000000..fd16aa4 --- /dev/null +++ b/openpoker-server/src/deal_cards.erl @@ -0,0 +1,142 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(deal_cards). +-behaviour(cardgame). + +-export([stop/1, test/0]). + +-export([init/1, terminate/3]). +-export([handle_event/3, handle_info/3, + handle_sync_event/4, code_change/4]). + +-export([deal_cards/2]). + +-include("common.hrl"). +-include("proto.hrl"). +-include("texas.hrl"). +-include("test.hrl"). + +-record(data, { + game, + n, + type + }). + +init([Game, N, Type]) -> + Data = #data { + game = Game, + n = N, + type = Type + }, + {ok, deal_cards, Data}. + +stop(Ref) -> + cardgame:send_all_state_event(Ref, stop). + +deal_cards({'START', Context}, Data) -> + Game = Data#data.game, + Deck = gen_server:call(Game, 'DECK'), + case Data#data.type of + private -> + B = element(2, Context), + Seats = gen_server:call(Game, {'SEATS', B, ?PS_STANDING}), + deal_private(Game, Deck, Seats, Data#data.n); + shared -> + deal_shared(Game, Deck, Data#data.n) + end, + {stop, {normal, Context}, Data}; + +deal_cards({timeout, _Timer, _Player}, Data) -> + {next_state, deal_cards, Data}; + +deal_cards(Event, Data) -> + handle_event(Event, deal_cards, Data). + +handle_event(stop, _State, Data) -> + {stop, normal, Data}; + +handle_event(Event, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {message, Event}, + {self, self()}, + {game, Data#data.game}]), + {next_state, State, Data}. + +handle_sync_event(Event, From, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {message, Event}, + {from, From}, + {self, self()}, + {game, Data#data.game}]), + {next_state, State, Data}. + +handle_info(Info, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {message, Info}, + {self, self()}, + {game, Data#data.game}]), + {next_state, State, Data}. + +terminate(_Reason, _State, _Data) -> + ok. + +code_change(_OldVsn, State, Data, _Extra) -> + {ok, State, Data}. + +%% +%% Utility +%% + +deal_shared(_Game, _Deck, 0) -> + ok; + +deal_shared(Game, Deck, N) -> + Card = gen_server:call(Deck, 'DRAW'), + gen_server:cast(Game, {'DRAW SHARED', Card}), + deal_shared(Game, Deck, N - 1). + +deal_private(_Game, _Deck, _Seats, 0) -> + ok; + +deal_private(Game, Deck, Seats, N) -> + F = fun(Seat) -> + Card = gen_server:call(Deck, 'DRAW'), + Player = gen_server:call(Game, {'PLAYER AT', Seat}), + %% + %%PID = gen_server:call(Player, 'ID'), + %%io:format("Dealing ~w to ~w/~w~n", + %% [Card, PID, Seat]), + %% + gen_server:cast(Game, {'DRAW', Player, Card}) + end, + lists:foreach(F, Seats), + deal_private(Game, Deck, Seats, N - 1). + +%% +%% Test suite +%% + +test() -> + ok. diff --git a/openpoker-server/src/deck.erl b/openpoker-server/src/deck.erl new file mode 100644 index 0000000..f61f09a --- /dev/null +++ b/openpoker-server/src/deck.erl @@ -0,0 +1,169 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(deck). +-behaviour(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). + +-export([start/0, start_link/0, stop/1, test/0]). + +-include("test.hrl"). +-include("common.hrl"). + +-record(data, { + rigged, + cards + }). + +new() -> + #data { + rigged = [], + cards = shuffle(make_deck()) + }. + +start() -> + gen_server:start(deck, [], []). + +start_link() -> + gen_server:start_link(deck, [], []). + +init(_) -> + process_flag(trap_exit, true), + {ok, new()}. + +stop(DeckRef) -> + gen_server:cast(DeckRef, stop). + +terminate(normal, _Data) -> + ok. + +handle_cast(stop, Data) -> + {stop, normal, Data}; + +handle_cast('RESET', Data) -> + Data1 = case Data#data.rigged of + [] -> + %%io:format("Deck is not rigged~n"), + new(); + Cards -> + %%io:format("Deck is rigged with ~w~n", [Cards]), + Data#data { + cards = Cards + } + end, + {noreply, Data1}; + +handle_cast({'RIG', Cards}, Data) -> + Data1 = Data#data { + rigged = Cards, + cards = Cards + }, + {noreply, Data1}; + +handle_cast(Event, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {deck, self()}, + {message, Event}]), + {noreply, Data}. + +handle_call('DRAW', _From, Data) -> + if + length(Data#data.cards) > 0 -> + [Card|Rest] = Data#data.cards, + Data1 = Data#data { + cards = Rest + }, + {reply, Card, Data1}; + true -> + {reply, none, Data} + end; + +handle_call(Event, From, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {deck, self()}, + {message, Event}, + {from, From}]), + {noreply, Data}. + +handle_info({'EXIT', _Pid, _Reason}, Data) -> + %% child exit? + {noreply, Data}; + +handle_info(Info, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {deck, self()}, + {message, Info}]), + {noreply, Data}. + +code_change(_OldVsn, Deck, _Extra) -> + {ok, Deck}. + +make_deck() -> + Face = [ two, + three, + four, + five, + six, + seven, + eight, + nine, + ten, + jack, + queen, + king, + ace ], + Suit = [ clubs, + diamonds, + hearts, + spades ], + make_deck(Face, Suit, []). + +make_deck(Face, [Suit|Rest], Acc) when atom(Face) -> + make_deck(Face, Rest, [{ Face, Suit }|Acc]); + +make_deck(_Face, [], Acc) -> + Acc; + +make_deck([Face|Rest], Suit, Acc) -> + Acc1 = make_deck(Face, Suit, Acc), + make_deck(Rest, Suit, Acc1); + +make_deck([], _Suit, Acc) -> + Acc. + +shuffle(Cards) -> + Temp = lists:map(fun(X) -> + {random:uniform(1 bsl 64), X} + end, + Cards), + Temp1 = lists:keysort(1, Temp), + lists:map(fun(X) -> + element(2, X) + end, + Temp1). + +test() -> + ok. diff --git a/openpoker-server/src/delayed_start.erl b/openpoker-server/src/delayed_start.erl new file mode 100644 index 0000000..439cca4 --- /dev/null +++ b/openpoker-server/src/delayed_start.erl @@ -0,0 +1,153 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(delayed_start). +-behaviour(cardgame). + +-export([stop/1, test/0]). + +-export([init/1, terminate/3]). +-export([handle_event/3, handle_info/3, + handle_sync_event/4, code_change/4]). + +-export([delayed_start/2]). + +-include("common.hrl"). +-include("lang.hrl"). +-include("test.hrl"). +-include("proto.hrl"). + +-record(data, { + game, + context, + delay + }). + +init([Game, Delay]) -> + Data = #data { + game = Game, + delay = Delay + }, + {ok, delayed_start, Data}. + +stop(Ref) -> + cardgame:send_all_state_event(Ref, stop). + +delayed_start({'START', Context}, Data) -> + Delay = Data#data.delay, + cardgame:send_event_after(Delay, 'CHECK'), + %% reset call amount + Context1 = setelement(3, Context, 0), + Data1 = Data#data { + context = Context1 + }, + {next_state, delayed_start, Data1}; + +delayed_start('CHECK', Data) -> + Game = Data#data.game, + Active = gen_server:call(Game, {'SEATS', ?PS_ACTIVE}), + BBActive = gen_server:call(Game, {'SEATS', ?PS_BB_ACTIVE}), + ReqCount = gen_server:call(Game, 'REQUIRED'), + L1 = length(Active), + L2 = length(BBActive), + Start = (L1 >= ReqCount) or ((L1 > 0) and (L2 > ReqCount)), + Empty = gen_server:call(Game, 'IS EMPTY'), + if + Start -> + gen_server:cast(Game, 'RESET'), + Msg = lang:msg(?GAME_STARTING), + gen_server:cast(Game, {'BROADCAST', {?PP_NOTIFY_CHAT, 0, Msg}}), + gen_server:cast(Game, {'BROADCAST', {?PP_NOTIFY_START_GAME}}), + {stop, {normal, Data#data.context}, Data}; + Empty -> + {stop, {normal, restart}, Data}; + true -> + Msg = lang:msg(?GAME_CANCELLED), + gen_server:cast(Game, {'BROADCAST', {?PP_NOTIFY_CHAT, 0, Msg}}), + gen_server:cast(Game, {'BROADCAST', {?PP_NOTIFY_CANCEL_GAME}}), + {stop, {normal, restart}, Data} + end; + +delayed_start({?PP_JOIN, Player, SeatNum, BuyIn}, Data) -> + Game = Data#data.game, + gen_server:cast(Game, {?PP_JOIN, Player, SeatNum, BuyIn, ?PS_PLAY}), + {next_state, delayed_start, Data}; + +delayed_start({?PP_LEAVE, Player}, Data) -> + Game = Data#data.game, + gen_server:cast(Game, {?PP_LEAVE, Player}), + {next_state, delayed_start, Data}; + +delayed_start({?PP_SIT_OUT, Player}, Data) -> + Game = Data#data.game, + gen_server:cast(Game, {'SET STATE', Player, ?PS_SIT_OUT}), + {next_state, delayed_start, Data}; + +delayed_start({?PP_COME_BACK, Player}, Data) -> + Game = Data#data.game, + gen_server:cast(Game, {'SET STATE', Player, ?PS_PLAY}), + {next_state, delayed_start, Data}; + +delayed_start(Event, Data) -> + handle_event(Event, delayed_start, Data). + +handle_event(stop, _State, Data) -> + {stop, normal, Data}; + +handle_event(Event, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {message, Event}, + {self, self()}, + {game, Data#data.game}]), + {next_state, State, Data}. + +handle_sync_event(Event, From, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {from, From}, + {message, Event}, + {self, self()}, + {game, Data#data.game}]), + {next_state, State, Data}. + +handle_info(Info, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {message, Info}, + {self, self()}, + {game, Data#data.game}]), + {next_state, State, Data}. + +terminate(_Reason, _State, _Data) -> + ok. + +code_change(_OldVsn, State, Data, _Extra) -> + {ok, State, Data}. + + +%% +%% Test suite +%% + +test() -> + ok. + diff --git a/openpoker-server/src/fixed_limit.erl b/openpoker-server/src/fixed_limit.erl new file mode 100644 index 0000000..4eaf57f --- /dev/null +++ b/openpoker-server/src/fixed_limit.erl @@ -0,0 +1,112 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(fixed_limit). +-behaviour(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). + +-export([start/2, start_link/2, stop/1, test/0]). + +-include("test.hrl"). +-include("common.hrl"). +-include("proto.hrl"). + +-record(fixed_limit, { + high, + low + }). + +new(Low, High) -> + #fixed_limit { + high = High, + low = Low + }. + +start(Low, High) -> + gen_server:start(fixed_limit, [Low, High], []). + +start_link(Low, High) -> + gen_server:start_link(fixed_limit, [Low, High], []). + +init([Low, High]) -> + process_flag(trap_exit, true), + {ok, new(Low, High)}. + +stop(LimitRef) -> + gen_server:cast(LimitRef, stop). + +terminate(_Reason, _Limit) -> + ok. + +handle_cast(stop, Limit) -> + {stop, normal, Limit}; + +handle_cast(Event, Limit) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Event}]), + {noreply, Limit}. + +handle_call('INFO', _From, Limit) -> + {reply, {?LT_FIXED_LIMIT, + Limit#fixed_limit.low, + Limit#fixed_limit.high}, Limit}; + +handle_call({'RAISE SIZE', _Game, _Player, Stage}, _From, Limit) -> + {reply, raise_size(Limit, Stage), Limit}; + +handle_call('BLINDS', _From, Limit) -> + {reply, {Limit#fixed_limit.low div 2, Limit#fixed_limit.low}, Limit}; + +handle_call(Event, From, Limit) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Event}, + {from, From}]), + {noreply, Limit}. + +handle_info({'EXIT', _Pid, _Reason}, Limit) -> + %% child exit? + {noreply, Limit}; + +handle_info(Info, Limit) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Info}]), + {noreply, Limit}. + +code_change(_OldVsn, Limit, _Extra) -> + {ok, Limit}. + +raise_size(Limit, Stage) when ?GS_PREFLOP =:= Stage; + ?GS_FLOP =:= Stage -> + {Limit#fixed_limit.low, Limit#fixed_limit.low}; + +raise_size(Limit, _Stage) -> + {Limit#fixed_limit.high, Limit#fixed_limit.high}. + +test() -> + ok. diff --git a/openpoker-server/src/game.erl b/openpoker-server/src/game.erl new file mode 100644 index 0000000..23f91a0 --- /dev/null +++ b/openpoker-server/src/game.erl @@ -0,0 +1,828 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(game). +-behaviour(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). +-export([start/4, stop/1, test/0]). +-export([find/8, setup/6]). + +-include_lib("stdlib/include/qlc.hrl"). + +-include("common.hrl"). +-include("test.hrl"). +-include("proto.hrl"). +-include("schema.hrl"). + +-record(seat, { + %% player process + player, + %% total bet amount + bet, + %% cards + hand, + %% player state + state, + %% sequence number. tracks the last + %% game update packet accepted by this player. + %% meant to track the last packet sent + %% over the network connection. + seqnum = 0 + }). + +-record(game, { + oid, + %% game type + type, + %% cardgame state machine process + fsm, + %% player to seat cross-reference + xref = gb_trees:empty(), + %% seats tuple + seats, + %% fixed, pot, no limit, etc. process + limit, + %% card deck process + deck, + %% shared cards list + board = [], + %% pot process + pot, + %% game observers + observers = [], + %% time given to players + %% to make a move + timeout = ?PLAYER_TIMEOUT, + %% amount to call + call = 0, + %% number of raises so far + raise_count = 0, + %% current sequence number + seqnum = 0, + %% players required to start a game + required_player_count = 2, + %% event history + event_history = [] + }). + +new(OID, FSM, GameType, SeatCount, LimitType) -> + {ok, Deck} = deck:start_link(), + {ok, Pot} = pot:start_link(), + {ok, Limit} = case LimitType of + {?LT_FIXED_LIMIT, Low, High} -> + fixed_limit:start_link(Low, High) + end, + _ = #game { + oid = OID, + fsm = FSM, + type = GameType, + deck = Deck, + pot = Pot, + seats = create_seats(SeatCount), + limit = Limit + }. + +start(FSM, GameType, SeatCount, LimitType) -> + gen_server:start(game, [FSM, GameType, SeatCount, LimitType], []). + +init([FSM, GameType, SeatCount, LimitType]) + when is_pid(FSM), + is_number(GameType), + is_number(SeatCount), + is_tuple(LimitType) -> + process_flag(trap_exit, true), + OID = counter:bump(game), + Data = new(OID, FSM, GameType, SeatCount, LimitType), + %% store game info + Game = #game_xref { + oid = OID, + pid = FSM, + type = GameType, + limit = LimitType + }, + case mnesia:transaction(fun() -> + mnesia:write(Game) + end) of + {atomic, ok} -> + {ok, Data}; + Any -> + {stop, Any} + end. + +stop(Game) + when is_pid(Game) -> + gen_server:cast(Game, stop). + +terminate(_Reason, Game) -> + dispose_seats(Game), + %% limit can be any of fixed, pot or no limit. + %% since we don't know the module we send + %% the stop message directly to the process. + gen_server:cast(Game#game.limit, stop), + deck:stop(Game#game.deck), + pot:stop(Game#game.pot), + %% remove ourselves from the db + db:delete(game_xref, Game#game.oid), + ok. + +%%% Reset is used each time the game is restarted + +handle_cast('RESET', Game) -> + gen_server:cast(Game#game.deck, 'RESET'), + gen_server:cast(Game#game.pot, 'RESET'), + Game1 = Game#game { + board = [], + call = 0, + raise_count = 0, + seqnum = 0, + event_history = [] + }, + Game2 = reset_bets(Game1), + Game3 = reset_state(Game2), + {noreply, Game3}; + +%%% Player timeout + +handle_cast({'TIMEOUT', Timeout}, Game) -> + Game1 = Game#game { + timeout = Timeout + }, + {noreply, Game1}; + +%%% Number of players required to start the game + +handle_cast({'REQUIRED', N}, Game) -> + N1 = if + N < 2 -> + 2; + true -> + N + end, + Game1 = Game#game { + required_player_count = N1 + }, + {noreply, Game1}; + +%%% Broadcast event to players and observers + +handle_cast({'BROADCAST', Event}, Game) -> + Game1 = broadcast(Game, Event), + {noreply, Game1}; + +%%% Only used for testing to rig the deck + +handle_cast({'RIG', Deck}, Game) -> + gen_server:cast(Game#game.deck, {'RIG', Deck}), + {noreply, Game}; + +%%% Watch the game without joining + +handle_cast({?PP_WATCH, Player}, Game) -> + Game1 = Game#game { + observers = [Player|Game#game.observers] + }, + {noreply, Game1}; + +handle_cast({?PP_UNWATCH, Player}, Game) -> + Game1 = Game#game { + observers = lists:delete(Player, Game#game.observers) + }, + {noreply, Game1}; + +%%% Need to be watching the game or playing +%%% to be able to send chat messages. + +handle_cast({?PP_CHAT, Player, Message}, Game) -> + XRef = Game#game.xref, + OurPlayer = gb_trees:is_defined(Player, XRef) + or lists:member(Player, Game#game.observers), + Game1 = if + OurPlayer -> + broadcast(Game, {?PP_NOTIFY_CHAT, Player, Message}); + true -> + Game + end, + {noreply, Game1}; + +handle_cast({?PP_JOIN, Player, SeatNum, BuyIn}, Game) -> + handle_cast({?PP_JOIN, Player, SeatNum, BuyIn, ?PS_PLAY}, Game); + +%%% You need to have enough money to buy in +%%% and the seat has to be empty. + +handle_cast({?PP_JOIN, Player, SeatNum, BuyIn, State}, Game) -> + Seats = Game#game.seats, + XRef = Game#game.xref, + Seat = element(SeatNum, Seats), + OurPlayer = gb_trees:is_defined(Player, XRef), + if + %% seat is taken + Seat#seat.state /= ?PS_EMPTY -> + {noreply, Game}; + %% already sitting at this table + OurPlayer -> + {noreply, Game}; + true -> + %% try to move the buy-in amount + %% from balance to inplay + ID = gen_server:call(Player, 'ID'), + case db:move_amt(player, ID, {balance, inplay, BuyIn}) of + {atomic, ok} -> + %% update player + db:set(player, ID, {game, Game#game.fsm}), + %% notify player + gen_server:cast(Player, {'INPLAY+', BuyIn}), + %% take seat and broadcast the fact + Game1 = join_player(Game, Player, SeatNum, State), + Game2 = broadcast(Game1, {?PP_NOTIFY_JOIN, + Player, + SeatNum}), + {noreply, Game2}; + Any -> + %% not enough money + %% or another error + io:format("Move amt error: ~w for player ~w~n", + [Any, ID]), + B1 = db:get(player, ID, balance), + I1 = db:get(player, ID, inplay), + io:format("Balance: ~w, Inplay: ~w, BuyIn: ~w~n", + [B1, I1, BuyIn]), + {noreply, Game} + end + end; + +handle_cast({?PP_LEAVE, Player}, Game) -> + XRef = Game#game.xref, + Seats = Game#game.seats, + OurPlayer = gb_trees:is_defined(Player, XRef), + if + OurPlayer -> + SeatNum = gb_trees:get(Player, XRef), + Seat = element(SeatNum, Seats), + XRef1 = gb_trees:delete(Player, XRef), + Game1 = Game#game { + xref = XRef1, + seats = setelement(SeatNum, + Seats, + Seat#seat { + player = none, + state = ?PS_EMPTY + }) + }, + Game2 = broadcast(Game1, {?PP_NOTIFY_LEAVE, Player}), + {noreply, Game2}; + %% not playing here + true -> + {noreply, Game} + end; + +handle_cast({'DRAW', Player, Card}, Game) -> + SeatNum = gb_trees:get(Player, Game#game.xref), + Seat = element(SeatNum, Game#game.seats), + gen_server:cast(Seat#seat.hand, {'ADD CARD', Card}), + GID = Game#game.oid, + gen_server:cast(Player, {?PP_NOTIFY_DRAW, GID, Card, Game#game.seqnum}), + Game1 = broadcast(Game, {?PP_NOTIFY_PRIVATE, Player}), + {noreply, Game1}; + +handle_cast({'DRAW SHARED', Card}, Game) -> + Game1 = Game#game { + board = [Card|Game#game.board] + }, + Game2 = broadcast(Game1, {?PP_NOTIFY_SHARED, Card}), + {noreply, Game2}; + +handle_cast({'SET STATE', Player, State}, Game) -> + SeatNum = gb_trees:get(Player, Game#game.xref), + Seat = element(SeatNum, Game#game.seats), + Game1 = Game#game { + seats = setelement(SeatNum, + Game#game.seats, + Seat#seat { + state = State + }) + }, + {noreply, Game1}; + +%% Reset ?PS_BET to ?PS_PLAY + +handle_cast({'RESET STATE', Source, Target}, Game) -> + Game1 = reset_state(Game, Source, Target), + {noreply, Game1}; + +%% Reset bets to 0 + +handle_cast('NEW STAGE', Game) -> + gen_server:cast(Game#game.pot, 'NEW STAGE'), + Game1 = reset_bets(Game), + {noreply, Game1}; + +handle_cast({'ADD BET', Player, Amount}, Game) when Amount >= 0 -> + SeatNum = gb_trees:get(Player, Game#game.xref), + Seat = element(SeatNum, Game#game.seats), + InPlay = gen_server:call(Player, 'INPLAY'), + if + Amount > InPlay -> + {noreply, Game}; + true -> + if + Amount == InPlay -> + State = ?PS_ALL_IN, + AllIn = true, + Game1 = broadcast(Game, {?PP_PLAYER_STATE, + Player, + ?PS_ALL_IN}); + true -> + State = Seat#seat.state, + AllIn = false, + Game1 = Game + end, + gen_server:cast(Game1#game.pot, {'ADD BET', Player, Amount, AllIn}), + gen_server:cast(Player, {'INPLAY-', Amount}), + NewBet = Seat#seat.bet + Amount, + Game2 = Game1#game { + seats = setelement(SeatNum, + Game1#game.seats, + Seat#seat { + bet = NewBet, + state = State + }) + }, + {noreply, Game2} + end; + +handle_cast({'RESEND UPDATES', Player}, Game) -> + resend_updates(Game, Player), + {noreply, Game}; + +handle_cast(stop, Game) -> + {stop, normal, Game}; + +handle_cast(Event, Game) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Event}]), + {noreply, Game}. + +handle_call('ID', _From, Game) -> + {reply, Game#game.oid, Game}; + +handle_call('FSM', _From, Game) -> + {reply, Game#game.fsm, Game}; + +handle_call('DECK', _From, Game) -> + {reply, Game#game.deck, Game}; + +handle_call('TIMEOUT', _From, Game) -> + {reply, Game#game.timeout, Game}; + +handle_call('REQUIRED', _From, Game) -> + {reply, Game#game.required_player_count, Game}; + +handle_call('JOINED', _From, Game) -> + {reply, length(get_seats(Game, ?PS_ANY)), Game}; + +handle_call('WAITING', _From, Game) -> + {reply, 0, Game}; + +handle_call('BLINDS', _From, Game) -> + {reply, gen_server:call(Game#game.limit,'BLINDS'), Game}; + +handle_call({'RAISE SIZE', Player, Stage}, _From, Game) -> + Reply = gen_server:call(Game#game.limit, + {'RAISE SIZE', self(), Player, Stage}), + {reply, Reply, Game}; + +handle_call({'STATE', Player}, _From, Game) -> + case gb_trees:lookup(Player, Game#game.xref) of + none -> + {reply, none, Game}; + {value, SeatNum} -> + Seat = element(SeatNum, Game#game.seats), + {reply, Seat#seat.state, Game} + end; + +handle_call({'WHAT SEAT', Player}, _From, Game) -> + case gb_trees:lookup(Player, Game#game.xref) of + none -> + {reply, none, Game}; + {value, SeatNum} -> + {reply, SeatNum, Game} + end; + +handle_call({'SEAT TAKEN', SeatNum}, _From, Game) -> + Seat = element(SeatNum, Game#game.seats), + {reply, Seat#seat.state /= ?PS_EMPTY, Game}; + +handle_call({'BET TOTAL', Player}, _From, Game) -> + SeatNum = gb_trees:get(Player, Game#game.xref), + Seat = element(SeatNum, Game#game.seats), + {reply, Seat#seat.bet, Game}; + +handle_call({'PLAYER AT', SeatNum}, _From, Game) -> + Player = if + SeatNum > size(Game#game.seats) -> + none; + true -> + Seat = element(SeatNum, Game#game.seats), + Seat#seat.player + end, + {reply, Player, Game}; + +handle_call('IS EMPTY', _From, Game) -> + Seats = get_seats(Game, ?PS_ANY), + Empty = (Game#game.observers == []) and (Seats == []), + {reply, Empty, Game}; + +handle_call('SEAT COUNT', _From, Game) -> + {reply, size(Game#game.seats), Game}; + +handle_call('RANK HANDS', _From, Game) -> + Seats = get_seats(Game, ?PS_SHOWDOWN), + {reply, rank_hands(Game, Seats), Game}; + +handle_call('POTS', _From, Game) -> + Pots = gen_server:call(Game#game.pot, 'SIDE POTS'), + {reply, Pots, Game}; + +handle_call('POT TOTAL', _From, Game) -> + Total = gen_server:call(Game#game.pot, 'TOTAL'), + {reply, Total, Game}; + +handle_call({'SEATS', StartFrom, Mask}, _From, Game) -> + {reply, get_seats(Game, StartFrom, Mask), Game}; + +handle_call({'SEATS', Mask}, _From, Game) -> + {reply, get_seats(Game, Mask), Game}; + +handle_call('SEAT QUERY', _From, Game) -> + {reply, seat_query(Game), Game}; + +handle_call(Event, From, Game) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {id, Game#game.oid}, + {self, self()}, + {message, Event}, + {from, From}]), + {noreply, Game}. + +handle_info({'EXIT', _Pid, _Reason}, Game) -> + %% child exit? + {noreply, Game}; + +handle_info(Info, Game) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {id, Game#game.oid}, + {self, self()}, + {message, Info}]), + {noreply, Game}. + +code_change(_OldVsn, Game, _Extra) -> + {ok, Game}. + +%% +%% Utility +%% + +rank_hands(Game, Seats) -> + F = fun(SeatNum) -> + Seat = element(SeatNum, Game#game.seats), + Seat#seat.hand + end, + Hands = lists:map(F, Seats), + Cards = Game#game.board, + F1 = fun(Card) -> + F2 = fun(Hand) -> + gen_server:cast(Hand, {'ADD CARD', Card}) + end, + lists:foreach(F2, Hands) + end, + lists:foreach(F1, Cards), + lists:map(fun(Hand) -> + gen_server:call(Hand, 'RANK') + end, Hands). + +%% Initialize seats + +create_seats(SeatCount) -> + Seats = erlang:make_tuple(SeatCount, none), + create_seats(Seats, SeatCount). + +create_seats(Seats, I) when I =:= 0 -> + Seats; + +create_seats(Seats, I) -> + {ok, Hand} = hand:start_link(), + Seat = #seat { + player = none, + bet = 0, + hand = Hand, + state = ?PS_EMPTY + }, + NewSeats = setelement(I, Seats, Seat), + create_seats(NewSeats, I - 1). + +%% Cleanup seats + +dispose_seats(Game) -> + Seats = Game#game.seats, + if + Seats =/= none -> + dispose_seats(Seats, size(Seats)); + true -> + bad + end. + +dispose_seats(_Seats, 0) -> + ok; + +dispose_seats(Seats, Count) -> + Seat = element(Count, Seats), + hand:stop(Seat#seat.hand), + dispose_seats(Seats, Count - 1). + +%% Reset state + +reset_state(Game, From, To) -> + reset_state(Game, From, To, size(Game#game.seats)). + +reset_state(Game, _From, _To, 0) -> + Game; + +reset_state(Game, From, To, Count) -> + Seat = element(Count, Game#game.seats), + if + (Seat#seat.state band From) > 0 -> + NewGame = Game#game { + seats = setelement(Count, + Game#game.seats, + Seat#seat { + state = To + }) + }; + true -> + NewGame = Game + end, + reset_state(NewGame, From, To, Count - 1). + +%% Reset bets + +reset_bets(Game) -> + reset_bets(Game, size(Game#game.seats)). + +reset_bets(Game, 0) -> + Game; + +reset_bets(Game, Count) -> + Seat = element(Count, Game#game.seats), + NewGame = Game#game { + seats = setelement(Count, + Game#game.seats, + Seat#seat { + bet = 0 + }) + }, + reset_bets(NewGame, Count - 1). + +%% Reset player state + +reset_state(Game) -> + reset_state(Game, size(Game#game.seats)). + +reset_state(Game, 0) -> + Game; + +reset_state(Game, Count) -> + Seat = element(Count, Game#game.seats), + NewGame = if + Seat#seat.state == ?PS_FOLD -> + Game#game { + seats = setelement(Count, + Game#game.seats, + Seat#seat { + state = ?PS_PLAY + }) + }; + true -> + Game + end, + reset_state(NewGame, Count - 1). + +%% Create a list of seats matching a certain state + +get_seats(Game, From, Mask) -> + Size = size(Game#game.seats), + get_seats(Game#game.seats, Size, From, Size, Mask, []). + +get_seats(Game, Mask) -> + Size = size(Game#game.seats), + get_seats(Game#game.seats, Size, Size, Size, Mask, []). + +get_seats(_Seats, _Size, _At, 0, _Mask, Acc) -> + lists:reverse(Acc); + +get_seats(Seats, Size, At, Counter, Mask, Acc) -> + SeatNum = (At rem Size) + 1, + Seat = element(SeatNum, Seats), + IsMember = (Seat#seat.state band Mask) > 0, + List = if + IsMember -> + [SeatNum|Acc]; + true -> + Acc + end, + get_seats(Seats, Size, At + 1, Counter - 1, Mask, List). + +%% Broadcast event + +add_seqnum(Game, Event) + when is_tuple(Event) -> + add_seqnum(Game, tuple_to_list(Event)); + +add_seqnum(Game, [?PP_NOTIFY_CHAT, Player, Msg]) -> + [?PP_NOTIFY_CHAT, Game#game.oid, Player, Game#game.seqnum, Msg]; + +add_seqnum(Game, List) + when is_list(List) -> + [Type|Rest] = List, + [Type, Game#game.oid|Rest] ++ [Game#game.seqnum]. + +make_players(Game, Seats) -> + make_players(Game, Seats, []). + +make_players(_Game, [], Acc) -> + lists:reverse(Acc); + +make_players(Game, [SeatNum|Rest], Acc) -> + Seat = element(SeatNum, Game#game.seats), + Player = Seat#seat.player, + make_players(Game, Rest, [Player|Acc]). + +broadcast(Game, Event) + when is_record(Game, game) -> + Event1 = add_seqnum(Game, Event), + Event2 = list_to_tuple(Event1), + %% notify players + Seats = get_seats(Game, ?PS_ANY), + Players = make_players(Game, Seats), + broadcast(Game, Players, Event2), + broadcast(Game, Game#game.observers, Event2). + +broadcast(Game, [Player|Rest], Event) -> + gen_server:cast(Player, Event), + broadcast(Game, Rest, Event); + +broadcast(Game, [], Event) -> + Game#game { + seqnum = Game#game.seqnum + 1, + event_history = [Event|Game#game.event_history] + }. + +resend_updates(Game, Player) + when is_record(Game, game), + is_pid(Player) -> + resend_updates(Player, lists:reverse(Game#game.event_history)); + +resend_updates(Player, [Event|Rest]) -> + gen_server:cast(Player, Event), + resend_updates(Player, Rest); + +resend_updates(_Player, []) -> + ok. + +%% Seat query + +seat_query(Game) -> + Size = size(Game#game.seats), + seat_query(Game, Size, []). + +seat_query(_Game, 0, Acc) -> + Acc; + +seat_query(Game, SeatNum, Acc) -> + Seat = element(SeatNum, Game#game.seats), + Player = Seat#seat.player, + State = case Seat#seat.state of + ?PS_EMPTY -> + ?SS_EMPTY; + ?PS_RESERVED -> + ?SS_RESERVED; + _ -> + ?SS_TAKEN + end, + Acc1 = [{SeatNum, State, Player}|Acc], + seat_query(Game, SeatNum - 1, Acc1). + +join_player(Game, Player, SeatNum, State) -> + Seats = Game#game.seats, + Seat = element(SeatNum, Seats), + XRef = Game#game.xref, + XRef1 = gb_trees:insert(Player, SeatNum, XRef), + %% assign hand owner + gen_server:cast(Seat#seat.hand, {'RESET', Player}), + %% remove from the list of observers + Observers = lists:delete(Player, Game#game.observers), + Game#game { + xref = XRef1, + seats = setelement(SeatNum, + Seats, + Seat#seat { + player = Player, + state = State + }), + observers = Observers + }. + +query_op(Arg, Op, Value) + when is_number(Arg), + is_number(Value) -> + case Op of + ?OP_IGNORE -> + true; + ?OP_EQUAL -> + Arg == Value; + ?OP_LESS -> + Arg < Value; + ?OP_GREATER -> + Arg > Value; + _ -> + false + end. + +find(GameType, LimitType, + ExpOp, Expected, + JoinOp, Joined, + WaitOp, Waiting) -> + F = fun() -> find_1(GameType, LimitType) end, + {atomic, L} = mnesia:transaction(F), + F1 = fun(Packet) -> + {_, _, _, Expected1, Joined1, Waiting1, _} + = Packet, + query_op(Expected1, ExpOp, Expected) + and query_op(Joined1, JoinOp, Joined) + and query_op(Waiting1, WaitOp, Waiting) + end, + {atomic, lists:filter(F1, L)}. + +find_1(GameType, LimitType) -> + Q = qlc:q([{G#game_xref.oid, + G#game_xref.pid, + G#game_xref.type, + G#game_xref.limit} + || G <- mnesia:table(game_xref), + G#game_xref.type == GameType, + element(1, G#game_xref.limit) == LimitType]), + L = qlc:e(Q), + lists:map(fun({GID, Pid, Type, Limit}) -> + Expected = cardgame:call(Pid, 'SEAT COUNT'), + Joined = cardgame:call(Pid, 'JOINED'), + Waiting = 0, % not implemented + {?PP_GAME_INFO, GID, Type, + Expected, Joined, Waiting, Limit} + end, L). + +setup(GameType, SeatCount, Limit, Delay, Timeout, Max) -> + Game = #game_config { + id = erlang:phash2(now(), 1 bsl 32), + type = GameType, + seat_count = SeatCount, + limit = Limit, + start_delay = Delay, + player_timeout = Timeout, + max = Max + }, + F = fun() -> mnesia:write(Game) end, + mnesia:transaction(F). + +%% +%% +%% Test suite +%% + +test() -> + ok. + + + diff --git a/openpoker-server/src/gateway.erl b/openpoker-server/src/gateway.erl new file mode 100644 index 0000000..dc411ff --- /dev/null +++ b/openpoker-server/src/gateway.erl @@ -0,0 +1,92 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(gateway). + +-export([start/3, start/1]). + +-include("common.hrl"). +-include("proto.hrl"). +-include("texas.hrl"). +-include("test.hrl"). + +start([Node, Port, MaxPlayers]) + when is_atom(Node), + is_atom(Port), + is_atom(MaxPlayers) -> + Port1 = list_to_integer(atom_to_list(Port)), + Max = list_to_integer(atom_to_list(MaxPlayers)), + start(Node, Port1, Max). + +start(Node, Port, MaxPlayers) -> + io:format("gateway:start(~w, ~w, ~w)~n", + [Node, Port, MaxPlayers]), + case net_adm:ping(Node) of + pong -> + io:format("Waiting for game servers...~n"), + case wait_for_game_servers(10) of + ok -> + F = fun(Sock) -> handoff(Sock, MaxPlayers) end, + tcp_server:start_raw_server(Port, F, 1000, 2048); + _ -> + io:format("No game servers found, exiting.~n") + end; + _ -> + io:format("Gateway cannot talk to Mnesia master ~w, exiting.~n", + [Node]) + end. + +find_server(MaxPlayers) -> + case pg2:get_closest_pid(?GAME_SERVERS) of + Pid when is_pid(Pid) -> + {_Time, {Host, Port}} = timer:tc(gen_server, call, [Pid, 'WHERE']), + Count = gen_server:call(Pid, 'USER COUNT'), + if + Count < MaxPlayers -> + io:format("~s:~w: ~w players~n", [Host, Port, Count]), + {Host, Port}; + true -> + io:format("~s:~w is full...~n", [Host, Port]), + find_server(MaxPlayers) + end; + Any -> + Any + end. + +handoff(Socket, Max) -> + {Host, Port} = find_server(Max), + ok = ?tcpsend(Socket, {?PP_HANDOFF, Port, Host}), + ok = gen_tcp:close(Socket). + +wait_for_game_servers(0) -> + none; + +wait_for_game_servers(Tries) -> + case pg2:which_groups() of + [?GAME_SERVERS] -> + ok; + _ -> + receive + after 2000 -> + ok + end, + wait_for_game_servers(Tries - 1) + end. diff --git a/openpoker-server/src/hand.erl b/openpoker-server/src/hand.erl new file mode 100644 index 0000000..fdcaaa3 --- /dev/null +++ b/openpoker-server/src/hand.erl @@ -0,0 +1,735 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(hand). +-behaviour(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). + +-export([start/0, start_link/0, stop/1, test/0, describe/1]). + +-export([make_card/1, face/1, suit/1, print_bin/1, print_rep/1]). + +-include("test.hrl"). + +-record(hand, { + id, + cards, + rank, + score, + high + }). + +new() -> + new(0, []). + +new(Id, Cards) -> + #hand { + id = Id, + cards = Cards + }. + +start() -> + gen_server:start(hand, [], []). + +start_link() -> + gen_server:start_link(hand, [], []). + +init(_) -> + process_flag(trap_exit, true), + {ok, new()}. + +stop(HandRef) -> + gen_server:cast(HandRef, stop). + +terminate(normal, _Hand) -> + ok. + +handle_cast({'ADD CARD', Card}, Hand) -> + NewHand = add(Hand, Card), + {noreply, NewHand}; + +handle_cast({'RESET', Id}, Hand) -> + NewHand = Hand#hand { + id = Id, + cards = [], + rank = none, + score = 0, + high = none + }, + {noreply, NewHand}; + +handle_cast(stop, Hand) -> + {stop, normal, Hand}; + +handle_cast(Event, Hand) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {hand, self()}, + {message, Event}]), + {noreply, Hand}. + +handle_call('CARDS', _From, Hand) -> + {reply, {Hand#hand.id, Hand#hand.cards}, Hand}; + +handle_call('RANK', _From, Hand) -> + NewHand = rank(Hand), + Id = NewHand#hand.id, + Value = rank_value(NewHand#hand.rank), + High = NewHand#hand.high, + Score = NewHand#hand.score, + {reply, {Id, Value, High, Score}, NewHand}; + +handle_call(Event, From, Hand) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {hand, self()}, + {message, Event}, + {from, From}]), + {noreply, Hand}. + +handle_info({'EXIT', _Pid, _Reason}, Hand) -> + %% child exit? + {noreply, Hand}; + +handle_info(Info, Hand) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {hand, self()}, + {message, Info}]), + {noreply, Hand}. + +code_change(_OldVsn, Hand, _Extra) -> + {ok, Hand}. + +%% +%% Utility +%% + +describe({8, High, _Score}) -> + "straight flush high " + ++ atom_to_list(face(High)) + ++ "s"; + +describe({7, High, _Score}) -> + "four of a kind " + ++ atom_to_list(face(High)) + ++ "s"; + +describe({6, High, _Score}) -> + Bin = <>, + <> = Bin, + "house of " + ++ atom_to_list(face(High3)) + ++ "s full of " + ++ atom_to_list(face(High2)) + ++ "s"; + +describe({5, High, _Score}) -> + "flush high " + ++ atom_to_list(face(High)) + ++ "s"; + +describe({4, High, _Score}) -> + "straight high " + ++ atom_to_list(face(High)) + ++ "s"; + +describe({3, High, _Score}) -> + "three of a kind " + ++ atom_to_list(face(High)) + ++ "s"; + +describe({2, High, _Score}) -> + High1 = face(High), + HighVal2 = High band (bnot face(High1)), + High2 = face(HighVal2), + "two pairs of " + ++ atom_to_list(High1) + ++ "s and " + ++ atom_to_list(High2) + ++ "s"; + +describe({1, High, _Score}) -> + "pair of " + ++ atom_to_list(face(High)) + ++ "s"; + +describe({0, High, _Score}) -> + "high card " + ++ atom_to_list(face(High)). + +add(Hand, Card) -> + Hand#hand{ + cards = [Card|Hand#hand.cards] + }. + +rank(Hand) -> + Rep = make_rep(Hand), + {Rank, High, Score} = score(Rep), + Hand#hand { + rank = Rank, + high = High, + score = Score + }. + +score(Rep) -> + score([fun is_straight_flush/1, + fun is_four_kind/1, + fun is_full_house/1, + fun is_flush/1, + fun is_straight/1, + fun is_three_kind/1, + fun is_two_pair/1, + fun is_pair/1 + ], Rep). + +score([H|T], Rep) -> + case Score = H(Rep) of + junk -> + score(T, Rep); + _ -> + Score + end; + +score([], Rep) -> + Mask = make_mask(Rep), + High = bits:clear_extra_bits(Mask, 5), + {junk, High, 0}. + +make_rep(Hand) when record(Hand, hand) -> + make_rep(Hand#hand.cards); + +make_rep(Cards) when list(Cards) -> + make_rep(Cards, {0, 0, 0, 0}). + +make_rep([{Face, Suit}|T], Rep) -> + Suit1 = suit(Suit), + Old = element(Suit1, Rep), + Face1 = face(Face), + make_rep(T, setelement(Suit1, Rep, Old bor Face1)); + +make_rep([], Rep) -> + tuple_to_list(Rep). + +make_mask([C, D, H, S]) -> + C bor D bor H bor S. + +high_bit(Mask) -> + 1 bsl bits:log2(Mask). + +clear_high_bit([C, D, H, S], High) -> + [C band (bnot High), + D band (bnot High), + H band (bnot High), + S band (bnot High)]. + +score(Rep, High, Bits) -> + Mask = make_mask(Rep), + Mask1 = Mask band (bnot High), + bits:clear_extra_bits(Mask1, Bits). + +is_straight_flush(Rep) -> + Mask = make_mask(Rep), + case is_flush(Mask, Rep) of + {_, High, _} -> + case is_straight([High, High, High, High]) of + {_, High1, _} -> + {straight_flush, High1, 0}; + _ -> + junk + end; + _ -> + junk + end. + +is_flush(Rep) -> + Mask = make_mask(Rep), + is_flush(Mask, Rep). + +is_flush(Mask, [H|T]) -> + Score = Mask band H, + Count = bits:bits1(Score), + if + Count < 5 -> + is_flush(Mask, T); + true -> + {flush, bits:clear_extra_bits(Score, 5), 0} + end; + +is_flush(_, []) -> + junk. + +is_straight(Rep) -> + Temp = make_mask(Rep), + if %AKQJT98765432A + Temp band 2#10000000000000 > 0 -> + Value = Temp bor 1; + true -> + Value = Temp + end, %AKQJT98765432A + is_straight(Value, 2#11111000000000). + +is_straight(_, Mask) when Mask < 2#11111 -> + junk; + +is_straight(Value, Mask) when Mask >= 2#11111 -> + if + Value band Mask =:= Mask -> + {straight, Mask, 0}; + true -> + is_straight(Value, Mask bsr 1) + end. + +is_four_kind([C, D, H, S]) -> + Value = C band D band H band S, + if + Value > 0 -> + {four_kind, Value, score([C, D, H, S], Value, 1)}; + true -> + junk + end. + +is_full_house(Rep) -> + case is_three_kind(Rep) of + {_, High3, _} -> + case is_pair(clear_high_bit(Rep, High3)) of + {_, High2, _} -> + Score = (High3 bsl 16) bor High2, + {full_house, Score, 0}; + _ -> + junk + end; + _ -> + junk + end. + +is_three_kind([C, D, H, S]) -> + L = lists:sort(fun(A, B) -> + A > B + end, [C band D band H, + D band H band S, + H band S band C, + S band C band D]), + is_three_kind(L, [C, D, H, S]). + +is_three_kind([H|T], Rep) -> + if + H > 0 -> + {three_kind, high_bit(H), score(Rep, H, 2)}; + true -> + is_three_kind(T, Rep) + end; + +is_three_kind([], _Rep) -> + junk. + +is_two_pair(Rep) -> + case is_pair(Rep) of + {pair, High1, _} -> + Rep1 = clear_high_bit(Rep, High1), + case is_pair(Rep1) of + {pair, High2, _} -> + High = High1 bor High2, + {two_pair, High1 bor High2, score(Rep, High, 1)}; + _ -> + junk + end; + _ -> + junk + end. + +is_pair([C, D, H, S]) -> + L = lists:sort(fun(A, B) -> + A > B + end, [C band D, + D band H, + H band S, + S band C, + C band H, + D band S]), + is_pair(L, [C, D, H, S]). + +is_pair([H|T], Rep) -> + if + H > 0 -> + {pair, high_bit(H), score(Rep, H, 3)}; + true -> + is_pair(T, Rep) + end; + +is_pair([], _Rep) -> + junk. + +rank_value(Rank) when atom(Rank) -> + case Rank of + straight_flush -> 8; + four_kind -> 7; + full_house -> 6; + flush -> 5; + straight -> 4; + three_kind -> 3; + two_pair -> 2; + pair -> 1; + _ -> 0 + end. + +%% Make a list of {face, suit} tuples +%% from a space-delimited string +%% such as "AD JC 5S" + +make_cards(S) + when is_list(S) -> + lists:map(fun make_card/1, + string:tokens(S, " ")). + +%% Make a single card tuple + +make_card([H, T]) -> + Rank = case H of + $2 -> two; + $3 -> three; + $4 -> four; + $5 -> five; + $6 -> six; + $7 -> seven; + $8 -> eight; + $9 -> nine; + $T -> ten; + $J -> jack; + $Q -> queen; + $K -> king; + $A -> ace + end, + Suit = case T of + $C -> clubs; + $D -> diamonds; + $H -> hearts; + $S -> spades + end, + {Rank, Suit}. + +face(Face) when atom(Face)-> + 1 bsl case Face of + ace -> 13; + king -> 12; + queen -> 11; + jack -> 10; + ten -> 9; + nine -> 8; + eight -> 7; + seven -> 6; + six -> 5; + five -> 4; + four -> 3; + three -> 2; + two -> 1 + end; + +face(X) when is_number(X) -> + face(X, [ace, king, queen, jack, ten, nine, + eight, seven, six, five, four, three, two]). + +face(_X, []) -> + none; + +face(X, [Face|Rest]) -> + Match = (X band face(Face)) > 0, + if + Match -> + Face; + true -> + face(X, Rest) + end. + +suit(Suit) when is_atom(Suit) -> + case Suit of + clubs -> 1; + diamonds -> 2; + hearts -> 3; + spades -> 4 + end; + +suit(Suit) when is_number(Suit) -> + case Suit of + 1 -> clubs; + 2 -> diamonds; + 3 -> hearts; + 4 -> spades + end. + +%%% +%%% Test suite +%%% + +test() -> + test_make_rep(), + test_rank_1(), + test_rank_2(), + test_rank_3(), + test_rank_4(), + test_rank_5(), + test_rank_6(), + test_rank_7(), + test_rank_8(), + test_rank_9(), + test_winner_1(), + test_winner_2(), + test_winner_3(), + test_winner_4(), + test_winner_5(), + test_winner_6(), + test_winner_7(), + test_winner_8(), + test_winner_9(), + test_winner_10(), + test_winner_11(), + test_winner_12(), + ok. + +test_make_rep() -> + %% AKQJT98765432A + [2#00000010000000, + 2#00101000011000, + 2#00010001000000, + 2#00000000000000] + = make_rep(make_cards("4D JH 5D 8C QD TD 7H")). + +-define(score(Cards), + score(make_rep(make_cards(Cards)))). + +test_rank_1() -> + ?match({junk, 2#00111011000000, 0}, + ?score("4D JH 5D 8C QD TD 7H")), + ?match({junk, 2#11000110010000, 0}, + ?score("8C AD 5H 3S KD 9D 4D")), + ?match({junk, 2#00110010011000, 0}, + ?score("4C JH 5C 8D QC 2C 3D")). + +test_rank_2() -> + ?match({pair, 2#00000000000100, 2#01100100000000}, + ?score("KD 3S 5H 3D 6C QH 9S")), + ?match({pair, 2#10000000000000, 2#01000100010000}, + ?score("AC 2D 5D AS 4H 9D KD")), + ?match({pair, 2#00000000000100, 2#01011000000000}, + ?score("9S JH 5D TS 3C KC 3H")). + +test_rank_3() -> + ?match({two_pair, 2#01100000000000, 2#00010000000000}, + ?score("QC KD JD QD JC 5C KC")), + ?match({two_pair, 2#00000001100000, 2#00010000000000}, + ?score("7H 3H 6C TD 7C JH 6H")), + ?match({two_pair, 2#00010000010000, 2#00100000000000}, + ?score("4D 3S 5H JD JC QH 5S")), + ?match({two_pair, 2#10000000010000, 2#00000100000000}, + ?score("AC 2D 5D AS 5H 9D 4D")), + ?match({two_pair, 2#00010000010000, 2#01000000000000}, + ?score("9S JH 5D JS 5C KC 3D")). + +test_rank_4() -> + ?match({three_kind, 2#00100000000000, 2#01000100000000}, + ?score("KH 9S 5H QD QC QH 3S")), + ?match({three_kind, 2#01000000000000, 2#10000100000000}, + ?score("AC KC KD KS 7H 9D 4D")), + ?match({three_kind, 2#00100000000000, 2#01001000000000}, + ?score("KS TS QD QS QH 4C 5D")). + +test_rank_5() -> + ?match({straight, 2#01111100000000, 0}, + ?score("KC QS JH TC 9C 4D 3S")), + ?match({straight, 2#11111000000000, 0}, + ?score("AC KS QH JC TC 9D 4D")), + ?match({straight, 2#01111100000000, 0}, + ?score("KS QD JS TC 9S 2D 7S")), + ?match({straight, 2#00000000011111, 0}, + ?score("5C 4D 3H 2C AD 7H 9S")), + ?match({straight, 2#00000011111000, 0}, + ?score("5H 4S JC 8S 7D 6C 3C")). + +test_rank_6() -> + ?match({flush, 2#00110000011010, 0}, + ?score("4D JD 5D JC QD 2D 7H")), + ?match({flush, 2#11000100011000, 0}, + ?score("8C AD 5D AS KD 9D 4D")), + ?match({flush, 2#00110000011100, 0}, + ?score("4C JC 5C 8D QC 3C 7S")). + +test_rank_7() -> + ?match({full_house, (2#00010000000000 bsl 16) bor 2#00100000000000, 0}, + ?score("4D JS 5H JD JC QH QS")), + ?match({full_house, (2#10000000000000 bsl 16) bor 2#01000000000000, 0}, + ?score("AC AD KD AS KH 9D 4D")), + ?match({full_house, (2#00010000000000 bsl 16) bor 2#01000000000000, 0}, + ?score("3S JH JD JS KH KC 5D")), + ?match({full_house, (2#00100000000000 bsl 16) bor 2#00001000000000, 0}, + ?score("TD QH TH TC 6C QD QC")). + +test_rank_8() -> + ?match({four_kind, 2#00100000000000, 2#10000000000000}, + ?score("4D AS 5H QD QC QH QS")), + ?match({four_kind, 2#01000000000000, 2#10000000000000}, + ?score("AC KC KD KS KH 9D 4D")), + ?match({four_kind, 2#00100000000000, 2#01000000000000}, + ?score("KS TS QD QS QH QC 5D")). + +test_rank_9() -> + ?match({straight_flush, 2#01111100000000, 0}, + ?score("KC QC JC TC 9C 4D AS")), + ?match({straight_flush, 2#11111000000000, 0}, + ?score("AC KC QC JC TC 9D 4D")), + ?match({straight_flush, 2#01111100000000, 0}, + ?score("KS QS JS TS 9S AD 7S")). + +test_winner_1() -> + S1 = ?score("4D JH 5D 8C QD TD 7H"), + S2 = ?score("8C AD 5H 3S KD 9D 4D"), + S3 = ?score("4C JH 5C 8D QC 2C 3D"), + ?match(junk, element(1, S1)), + ?match(junk, element(1, S2)), + ?match(junk, element(1, S3)), + ?match(true, S2 > S1), + ?match(true, S2 > S3), + ?match(true, S1 > S3). + +test_winner_2() -> + S1 = ?score("KD 3S 5H 3D 6C QH 9S"), + S2 = ?score("AC 2D 5D AS 4H 9D KD"), + S3 = ?score("9S JH 5D TS 3C KC 3H"), + ?match(pair, element(1, S1)), + ?match(pair, element(1, S2)), + ?match(pair, element(1, S3)), + ?match(true, S2 > S1), + ?match(true, S2 > S3), + ?match(true, S1 > S3). + +test_winner_3() -> + S1 = ?score("4D 3S 5H JD JC QH 5S"), + S2 = ?score("AC 2D 5D AS 5H 9D 4D"), + S3 = ?score("9S JH 5D JS 5C KC 3D"), + ?match(two_pair, element(1, S1)), + ?match(two_pair, element(1, S2)), + ?match(two_pair, element(1, S3)), + ?match(true, S2 > S1), + ?match(true, S2 > S3), + ?match(true, S3 > S1). + +test_winner_4() -> + S1 = ?score("KH 9S 5H QD QC QH 3S"), + S2 = ?score("AC KC KD KS 7H 9D 4D"), + S3 = ?score("KS TS QD QS QH 4C 5D"), + ?match(three_kind, element(1, S1)), + ?match(three_kind, element(1, S2)), + ?match(three_kind, element(1, S3)), + ?match(true, S2 > S1), + ?match(true, S2 > S3), + ?match(true, S3 > S1). + +test_winner_5() -> + S1 = ?score("KC QS JH TC 9C 4D 3S"), + S2 = ?score("AC KS QH JC TC 9D 4D"), + S3 = ?score("KS QD JS TC 9S 2D 7S"), + ?match(straight, element(1, S1)), + ?match(straight, element(1, S2)), + ?match(straight, element(1, S3)), + ?match(true, S2 > S1), + ?match(true, S2 > S3), + ?match(true, S1 == S3). + +test_winner_6() -> + S1 = ?score("4D JD 5D JC QD 2D 7H"), + S2 = ?score("8C AD 5D AS KD 9D 4D"), + S3 = ?score("4C JC 5C 8D QC 3C 7S"), + S4 = ?score("4C JC 7C 8D QC 5C 7S"), + ?match(flush, element(1, S1)), + ?match(flush, element(1, S2)), + ?match(flush, element(1, S3)), + ?match(flush, element(1, S4)), + ?match(true, S2 > S1), + ?match(true, S2 > S3), + ?match(true, S3 > S1), + ?match(true, S4 > S1). + +test_winner_7() -> + S1 = ?score("4D AS 5H QD QC QH QS"), + S2 = ?score("AC KC KD KS KH 9D 4D"), + S3 = ?score("KS TS QD QS QH QC 5D"), + ?match(four_kind, element(1, S1)), + ?match(four_kind, element(1, S2)), + ?match(four_kind, element(1, S3)), + ?match(true, S2 > S1), + ?match(true, S2 > S3), + ?match(true, S1 > S3). + +test_winner_8() -> + S1 = ?score("KC QC JC TC 9C 4D AS"), + S2 = ?score("AC KC QC JC TC 9D 4D"), + S3 = ?score("KS QS JS TS 9S AD 7S"), + ?match(straight_flush, element(1, S1)), + ?match(straight_flush, element(1, S2)), + ?match(straight_flush, element(1, S3)), + ?match(true, S2 > S1), + ?match(true, S2 > S3), + ?match(true, S1 == S3). + +test_winner_9() -> + S1 = ?score("4D JS 5H JD JC QH QS"), + S2 = ?score("AC AD KD AS KH 9D 4D"), + S3 = ?score("3S JH JD JS KH KC 5D"), + ?match(full_house, element(1, S1)), + ?match(full_house, element(1, S2)), + ?match(full_house, element(1, S3)), + ?match(true, S2 > S1), + ?match(true, S2 > S3), + ?match(true, S3 > S1). + +test_winner_10() -> + S1 = ?score("5C TC 7H KH 5S TS KS"), + S2 = ?score("5C TC 7H KH 5S KC TH"), + ?match(two_pair, element(1, S1)), + ?match(two_pair, element(1, S2)), + ?match(true, S1 == S2). + +test_winner_11() -> + S1 = ?score("KH TC 9H 7D 6H 5D 2S"), + S2 = ?score("KH TC 9H 7H 6H 3D 2S"), + ?match(junk, element(1, S1)), + ?match(junk, element(1, S2)), + ?match(true, S1 == S2). + +test_winner_12() -> + S1 = ?score("2H 2C 5H 5S 5C 7C 4D"), + S2 = ?score("2H 2C 5H 5S 5D 4D 2D"), + ?match(full_house, element(1, S1)), + ?match(full_house, element(1, S2)), + ?match(true, S1 == S2). + +print_bin(X) -> + io:format("AKQJT98765432A~n"), + io:format("~14.2.0B~n", [X]). + +print_rep({C, D, H, S}) -> + io:format(" AKQJT98765432A~n"), + io:format("C: ~14.2.0B~n", [C]), + io:format("D: ~14.2.0B~n", [D]), + io:format("H: ~14.2.0B~n", [H]), + io:format("S: ~14.2.0B~n", [S]). + diff --git a/openpoker-server/src/id.erl b/openpoker-server/src/id.erl new file mode 100644 index 0000000..5af9bca --- /dev/null +++ b/openpoker-server/src/id.erl @@ -0,0 +1,41 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(id). + +-export([pid2key/1, pid2id/1, key2id/1]). + +pid2key(Pid) when is_pid(Pid) -> + {erlang:phash2(now(), 1 bsl 32), + erlang:phash2(Pid, 1 bsl 32)}. + +key2id(Key) + when is_tuple(Key), size(Key) == 2 -> + erlang:phash2(Key, 1 bsl 32). + +pid2id(Pid) when is_pid(Pid) -> + key2id(pid2key(Pid)). + + + + + + diff --git a/openpoker-server/src/ircdb.erl b/openpoker-server/src/ircdb.erl new file mode 100644 index 0000000..be3d534 --- /dev/null +++ b/openpoker-server/src/ircdb.erl @@ -0,0 +1,236 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(ircdb). +-export([convert/1]). + +-include("ircdb.hrl"). + +convert(Dir) -> + HandFile = Dir ++ "/hdb", + PlayerFile = Dir ++ "/pdb", + Ets = ets:new(ircdb, [{keypos, 2}]), + read_hand_file(Ets, HandFile), + read_player_file(Ets, PlayerFile), + {ok, Dets} = dets:open_file(ircdb, [{file, "ircdb.dat"}, + {keypos, 2}, + {ram_file, true}]), + ets:to_dets(Ets, Dets), + dets:close(Dets). + +read_hand_file(Db, File) -> + {ok, B} = file:read_file(File), + read_hand_data(Db, B). + +read_hand_data(_Db, <<>>) -> + ok; + +read_hand_data(Db, B) -> + {Line, Rest} = read_line(B), + parse_hand(Db, Line), + read_hand_data(Db, Rest). + +parse_hand(Db, B) -> + {Id, B1} = read_int(B), % game id + {_, B2} = read_word(B1), % set# + {_, B3} = read_word(B2), % game# + {PlayerCount, B4} = read_int(B3), % #irc_players + {FC, FA, B5} = read_split_int(B4), % flop + {TC, TA, B6} = read_split_int(B5), % turn + {RC, RA, B7} = read_split_int(B6), % river + {SC, SA, B8} = read_split_int(B7), % showdown + Cards = read_cards(B8), + Game = #irc_game { + id = Id, + player_count = PlayerCount, + stages = [{FC, FA}, {TC, TA}, {RC, RA}, {SC, SA}], + board = Cards, + players = erlang:make_tuple(PlayerCount, none) + }, + ets:insert(Db, Game). + +read_player_file(Db, File) -> + {ok, B} = file:read_file(File), + read_player_data(Db, B, 0). + +read_player_data(_Db, <<>>, _) -> + ok; + +read_player_data(Db, B, N) -> + {Line, Rest} = read_line(B), + parse_player(Db, Line), + read_player_data(Db, Rest, N + 1). + +parse_player(Db, B) -> + {Nick, B1} = read_string(B), % nick + {Id, B2} = read_int(B1), % game id + {_PlayerCount, B3} = read_int(B2), % #irc_players + {SeatNum, B4} = read_int(B3), % seat# + {PA, B5} = read_actions(B4), % preflop actions + {FA, B6} = read_actions(B5), % flop actions + {TA, B7} = read_actions(B6), % turn actions + {RA, B8} = read_actions(B7), % river actions + {Balance, B9} = read_int(B8), % balance + {TotalAction, B10} = read_int(B9), % total action + {Win, B11} = read_int(B10), % amount won + Cards = read_cards(B11), % pocket cards + Player = #irc_player { + nick = Nick, + actions = PA ++ FA ++ TA ++ RA, + cards = Cards, + balance = Balance, + total_action = TotalAction, + win = Win + }, + %% lookup database record + [Game] = ets:lookup(Db, Id), + NewGame = Game#irc_game { + players = setelement(SeatNum, + Game#irc_game.players, + Player) + }, + ets:insert(Db, NewGame). + +%% +%% Utility +%% + +slurp(B, X) -> + slurp(B, X, 0). + +slurp(B, X, N) -> + case B of + <> -> + slurp(B2, X, N); + <> -> + {B1, B2}; + <<_:N/binary>> = B -> + {B, <<>>}; + <<_:N/binary, _/binary>> = B -> + slurp(B, X, N + 1) + end. + +read_line(B) -> + slurp(B, $\n). + +read_word(B) -> + slurp(B, $\s). + +read_int(B) -> + {Temp, B1} = read_word(B), + List = binary_to_list(Temp), + Int = list_to_integer(List), + {Int, B1}. + +read_split_int(B) -> + {Temp, B1} = read_word(B), + {T1, T2} = slurp(Temp, $\/), + {I1, _} = read_int(T1), + {I2, _} = read_int(T2), + {I1, I2, B1}. + +read_string(B) -> + {Temp, B1} = read_word(B), + Str = binary_to_list(Temp), + {Str, B1}. + +make_card([R, S]) -> + Rank = case R of + $2 -> two; + $3 -> three; + $4 -> four; + $5 -> five; + $6 -> six; + $7 -> seven; + $8 -> eight; + $9 -> nine; + $T -> ten; + $J -> jack; + $Q -> queen; + $K -> king; + $A -> ace + end, + Suit = case S of + $c -> clubs; + $d -> diamonds; + $h -> hearts; + $s -> spades + end, + {Rank, Suit}. + +read_cards(<<>>) -> + []; + +read_cards(B) when is_binary(B) -> + read_cards(B, []). + +read_cards(<<>>, Acc) -> + lists:reverse(Acc); + +read_cards(B, Acc) when is_binary(B) -> + case read_word(B) of + {<<>>, _} -> + Acc; + {Temp, B1} -> + Temp1 = binary_to_list(Temp), + Card = make_card(Temp1), + read_cards(B1, [Card|Acc]) + end. + +read_actions(B) when is_binary(B) -> + {Temp, B1} = read_word(B), + List = binary_to_list(Temp), + Actions = read_actions(List, []), + {Actions, B1}. + +action(X) -> + case X of + $B -> + 'BLIND'; + $f -> + 'FOLD'; + $k -> + 'CHECK'; + $b -> + 'BET'; + $c -> + 'CALL'; + $r -> + 'RAISE'; + $K -> + 'FOLD'; + $Q -> + 'FOLD'; + $- -> + none; + X -> + io:format("Unknown action: ~c~n", [X]), + X + end. + +read_actions([], Acc) -> + lists:reverse(Acc); + +read_actions([A, $\A|Rest], Acc) -> + read_actions(Rest, [{action(A), allin}|Acc]); + +read_actions([A|Rest], Acc) -> + read_actions(Rest, [action(A)|Acc]). diff --git a/openpoker-server/src/ircdb.hrl b/openpoker-server/src/ircdb.hrl new file mode 100644 index 0000000..799e12e --- /dev/null +++ b/openpoker-server/src/ircdb.hrl @@ -0,0 +1,40 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-record(irc_player, { + nick, + %% [action1, action2, ...] + actions, + cards, + total_action, + balance, + win + }). + +-record(irc_game, { + id, + player_count, + %% [{#players, pot$}, ...] + stages, + board, + players + }). + diff --git a/openpoker-server/src/lang.erl b/openpoker-server/src/lang.erl new file mode 100644 index 0000000..dc589cb --- /dev/null +++ b/openpoker-server/src/lang.erl @@ -0,0 +1,35 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(lang). +-export([msg/1]). + +-include("lang.hrl"). + +msg(Code) -> + case Code of + ?GAME_CANCELLED -> + "Game is cancelled, not enough players"; + ?GAME_STARTING -> + "Game is starting"; + _ -> + "Wrong message code" + end. diff --git a/openpoker-server/src/lang.hrl b/openpoker-server/src/lang.hrl new file mode 100644 index 0000000..2d092cb --- /dev/null +++ b/openpoker-server/src/lang.hrl @@ -0,0 +1,25 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +%% Game is cancelled, not enough players + +-define(GAME_CANCELLED, 0). +-define(GAME_STARTING, 1). diff --git a/openpoker-server/src/login.erl b/openpoker-server/src/login.erl new file mode 100644 index 0000000..3a2e4f8 --- /dev/null +++ b/openpoker-server/src/login.erl @@ -0,0 +1,192 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(login). + +-export([login/3, logout/1, test/0]). + +-include("proto.hrl"). +-include("test.hrl"). +-include("schema.hrl"). + +login({atomic, []}, _) -> + %% player not found + {error, ?ERR_BAD_LOGIN}; + +login({atomic, [Player]}, [_Nick, Pass|_] = Args) + when is_record(Player, player) -> + %% replace dead pids with none + Player1 = Player#player { + socket = fix_pid(Player#player.socket), + pid = fix_pid(Player#player.pid) + }, + %% check player state and login + Condition = check_player(Player1, [Pass], + [ + fun is_account_disabled/2, + fun is_bad_password/2, + fun is_player_busy/2, + fun is_player_online/2, + fun is_client_down/2, + fun is_offline/2 + ]), + {Player2, Result} = login(Player1, Condition, Args), + F = fun() -> mnesia:write(Player2) end, + case mnesia:transaction(F) of + {atomic, ok} -> + Result; + _ -> + {error, ?ERR_UNKNOWN} + end. + +login(Nick, Pass, Socket) + when is_list(Nick), + is_list(Pass), + is_pid(Socket) -> % socket handler process + login(db:find(player, nick, Nick), [Nick, Pass, Socket]); + +login(Player, bad_password, _) -> + N = Player#player.login_errors + 1, + {atomic, MaxLoginErrors} = + db:get(cluster_config, 0, max_login_errors), + if + N > MaxLoginErrors -> + %% disable account + Player1 = Player#player { + disabled = true + }, + {Player1, {error, ?ERR_ACCOUNT_DISABLED}}; + true -> + Player1 = Player#player { + login_errors = N + }, + {Player1, {error, ?ERR_BAD_LOGIN}} + end; + +login(Player, account_disabled, _) -> + {Player, {error, ?ERR_ACCOUNT_DISABLED}}; + +login(Player, player_online, Args) -> + %% player is idle + logout(Player#player.oid), + login(Player, player_offline, Args); + +login(Player, client_down, [_, _, Socket]) -> + %% tell player process to talk to the new socket + gen_server:cast(Player#player.pid, {'SOCKET', Socket}), + Player1 = Player#player { + socket = Socket + }, + {Player1, {ok, Player#player.pid}}; + +login(Player, player_busy, Args) -> + Temp = login(Player, client_down, Args), + cardgame:cast(Player#player.game, + {'RESEND UPDATES', Player#player.pid}), + Temp; + +login(Player, player_offline, [Nick, _, Socket]) -> + %% start player process + {ok, Pid} = player:start(Nick), + OID = gen_server:call(Pid, 'ID'), + gen_server:cast(Pid, {'SOCKET', Socket}), + %% update player record + Player1 = Player#player { + oid = OID, + pid = Pid, + socket = Socket + }, + {Player1, {ok, Pid}}. + +%%% +%%% Check player state +%%% + +check_player(Player, Args, [Guard|Rest]) -> + case Guard(Player, Args) of + {true, Condition} -> + Condition; + _ -> + check_player(Player, Args, Rest) + end; + +check_player(_Player, _Args, []) -> + %% fall through + unknown_error. + +is_bad_password(Player, [Pass]) -> + Hash = erlang:phash2(Pass, 1 bsl 32), + Match = Player#player.password == Hash, + {not Match, bad_password}. + +is_account_disabled(Player, _) -> + {Player#player.disabled, account_disabled}. + +is_player_busy(Player, _) -> + {Online, _} = is_player_online(Player, []), + Playing = Player#player.game /= none, + {Online and Playing, player_busy}. + +is_player_online(Player, _) -> + SocketAlive = Player#player.socket /= none, + PlayerAlive = Player#player.pid /= none, + {SocketAlive and PlayerAlive, player_online}. + +is_client_down(Player, _) -> + SocketDown = Player#player.socket == none, + PlayerAlive = Player#player.pid /= none, + {SocketDown and PlayerAlive, client_down}. + +is_offline(Player, _) -> + SocketDown = Player#player.socket == none, + PlayerDown = Player#player.pid == none, + {SocketDown and PlayerDown, player_offline}. + +fix_pid(Pid) + when is_pid(Pid) -> + case util:is_process_alive(Pid) of + true -> + Pid; + _ -> + none + end; + +fix_pid(Pid) -> + Pid. + +logout(OID) -> + case db:find(player, OID) of + {atomic, [Player]} -> + player:stop(Player#player.pid), + {atomic, ok} = db:set(player, OID, + [{pid, none}, + {socket, none}]); + _ -> + oops + end. + +%%% +%%% Test suite +%%% + +test() -> + ok. + diff --git a/openpoker-server/src/monitor.erl b/openpoker-server/src/monitor.erl new file mode 100644 index 0000000..523825a --- /dev/null +++ b/openpoker-server/src/monitor.erl @@ -0,0 +1,137 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(monitor). +-behavior(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). + +-export([start/2, stop/1, monitor/2]). + +-include("test.hrl"). +-include("common.hrl"). +-include("proto.hrl"). + +-record(data, { + socket, + host, + port, + poll_freq, + ping_time, + avg_connect_time, + avg_ping_time + }). + +start(GameServer, PollFreq) -> + gen_server:start(monitor, [GameServer, PollFreq], []). + +init([GameServer, PollFreq]) -> + process_flag(trap_exit, true), + {Host, Port} = gen_server:call(GameServer, 'WHERE'), + Data = #data { + host = Host, + port = Port, + poll_freq = PollFreq, + avg_connect_time = nil, + avg_ping_time = nil + }, + erlang:start_timer(PollFreq, self(), nil), + {ok, Data}. + +stop(Ref) -> + gen_server:cast(Ref, stop). + +terminate(_Reason, _Data) -> + ok. + +handle_cast(stop, Data) -> + {stop, normal, Data}. + +handle_call(Event, From, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {from, From}, + {message, Event}]), + {noreply, Data}. + +handle_info({timeout, _, _}, Data) -> + {Time, {ok, Sock}} = timer:tc(tcp_server, + start_client, + [Data#data.host, Data#data.port, 1024]), + tcp_server:send(Sock, proto:write(?PP_PING)), + AvgTime = Data#data.avg_connect_time, + Data1 = Data#data { + socket = Sock, + avg_connect_time = if + AvgTime == nil -> + Time / 1000; + true -> + (Time + AvgTime) / 2000 + end, + ping_time = now() + }, + {noreply, Data1}; + +handle_info({tcp, _Socket, <>}, Data) -> + PongTime = now(), + PingTime = Data#data.ping_time, + Elapsed = timer:now_diff(PongTime, PingTime), + AvgTime = Data#data.avg_ping_time, + gen_tcp:close(Data#data.socket), + Data1 = Data#data { + socket = nil, + avg_ping_time = if + AvgTime == nil -> + Elapsed / 1000; + true -> + (Elapsed + AvgTime) / 2000 + end + }, + io:format("~s:~w: ~.6.0f/~.6.0f~n", + [Data1#data.host, + Data1#data.port, + Data1#data.avg_connect_time, + Data1#data.avg_ping_time]), + erlang:start_timer(Data1#data.poll_freq, self(), nil), + {noreply, Data1}; + +handle_info(Info, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Info}]), + {noreply, Data}. + +code_change(_OldVsn, Data, _Extra) -> + {ok, Data}. + +monitor(Group, PollFreq) -> + monitor(pg2:get_members(Group), PollFreq, []). + +monitor([], _PollFreq, Acc) -> + Acc; + +monitor([Server|Rest], PollFreq, Acc) -> + {ok, Pid} = monitor:start(Server, PollFreq), + monitor(Rest, PollFreq, [Pid|Acc]). + diff --git a/openpoker-server/src/multibot.erl b/openpoker-server/src/multibot.erl new file mode 100644 index 0000000..7101ade --- /dev/null +++ b/openpoker-server/src/multibot.erl @@ -0,0 +1,687 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(multibot). +-behaviour(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). + +-export([start/0, stop/1, setup/1, cleanup/0]). + +-export([remove/1, print/1, filter/0, create_players/0, + test/3, test/4, test/5, count/0]). + +-include("test.hrl"). +-include("common.hrl"). +-include("ircdb.hrl"). +-include("proto.hrl"). +-include("schema.hrl"). + +%% test + +-record(test_game, { + irc_id, + observer, + players, + winners, + nicks, + trace + }). + +-record(data, { + db, + games = gb_trees:empty(), + failed = [], + started = 0, + player_count = 0, + finished = 0, + start_time, + trace = false + }). + +new() -> + #data { + start_time = erlang:now() + }. + +start() -> + gen_server:start(multibot, [], []). + +init([]) -> + process_flag(trap_exit, true), + {ok, new()}. + +stop(Ref) -> + gen_server:cast(Ref, stop). + +terminate(_Reason, Data) -> + Temp = abs(timer:now_diff(erlang:now(), Data#data.start_time)), + Elapsed = Temp / 1000000, + if + Data#data.finished > 0 -> + Avg = Elapsed / Data#data.finished; + true -> + Avg = 0 + end, + io:format("Elapsed: ~ws, Average run time: ~w seconds~n", + [Elapsed, Avg]), + ok. + +handle_cast({'RUN', Game, Host, Port, Trace, Delay}, Data) -> + if + Trace -> + io:format("RUN: ~w~n", [Game#irc_game.id]); + true -> + ok + end, + %% start test game + GID = start_game(Host, Port, Game, Delay), + Observer = setup_observer(self(), GID, Host, Port, Trace), + Players = setup_players(Game, GID, Host, Port), + TestGame = #test_game { + irc_id = Game#irc_game.id, + players = Players, + winners = ircdb_winners(Game), + nicks = ircdb_nicks(Game), + observer = Observer, + trace = Trace + }, + Games = Data#data.games, + Games1 = gb_trees:insert(GID, TestGame, Games), + Data1 = Data#data { + started = Data#data.started + 1, + player_count = Data#data.player_count + + Game#irc_game.player_count, + games = Games1 + }, + if + (Data1#data.started rem 50) == 0 -> + io:format("~w games started, ~w players~n", + [Data1#data.started, Data1#data.player_count]); + true -> + ok + end, + {noreply, Data1}; + +handle_cast(stop, Data) -> + {stop, normal, Data}; + +handle_cast(_Event, Data) -> + {noreply, Data}. + +handle_call(_Event, _From, Data) -> + {noreply, Data}. + +handle_info({'START', _GID}, Data) -> + {noreply, Data}; + +handle_info({'END', GID, Winners}, Data) -> + %% score it + Games = Data#data.games, + Game = gb_trees:get(GID, Games), + Winners1 = fixup_winners(Game, Winners), + Success = match_winners(Game#test_game.winners, Winners1), + if + Data#data.trace -> + io:format("END: ~w, Success: ~w~n", [GID, Success]); + true -> + ok + end, + Data1 = if + Success -> + Data; + true -> + if + Data#data.trace -> + io:format("~w: Expected winners: ~w~n", + [GID, Game#test_game.winners]), + io:format("~w: Received winners: ~w~n", + [GID, Winners1]); + true -> + ok + end, + Data#data { + failed = [Game#test_game.irc_id|Data#data.failed] + } + end, + %% clean up + Games1 = gb_trees:delete(GID, Games), + Data2 = Data1#data { + finished = Data1#data.finished + 1, + games = Games1 + }, + if + (Data2#data.finished rem 50) == 0 -> + io:format("~w games finished~n", [Data2#data.finished]); + true -> + ok + end, + if + Data2#data.finished == Data2#data.started -> + if + Data2#data.failed /= [] -> + {stop, Data2#data.failed, Data2}; + true -> + {stop, normal, Data2} + end; + true -> + {noreply, Data2} + end; + +handle_info(Info, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Info}]), + {noreply, Data}. + +code_change(_OldVsn, Data, _Extra) -> + {ok, Data}. + +opendb() -> + {ok, Dets} = dets:open_file(ircdb, [{file, "ircdb.dat"}, + {keypos, 2}]), + Dets. + +closedb(DB) -> + dets:close(DB). + +create_players() -> + DB = opendb(), + Key = dets:first(DB), + create_players(DB, Key). + +create_players(DB, '$end_of_table') -> + closedb(DB); + +create_players(DB, Key) -> + [Game] = dets:lookup(DB, Key), + create_players(Game), + Key1 = dets:next(DB, Key), + create_players(DB, Key1). + +create_players(Game) + when is_record(Game, irc_game) -> + Game1 = fix_nicks(Game), + create_players(tuple_to_list(Game1#irc_game.players)); + +create_players([]) -> + ok; + +create_players([Player|Rest]) + when is_record(Player, irc_player) -> + Nick = Player#irc_player.nick, + Balance = Player#irc_player.balance, + case db:find(player, nick, Nick) of + {atomic, [Player1]} -> + if + Player1#player.balance /= Balance -> + db:set(player, Player1#player.oid, + [{balance, Balance}, + {inplay, 0.0}]); + true -> + ok + end; + {atomic, []} -> + player:create(Nick, "foo", "", Balance) + end, + create_players(Rest). + +update_players(Game) + when is_record(Game, irc_game) -> + create_players(tuple_to_list(Game#irc_game.players)). + +test(Host, Port, MaxGames) -> + test(Host, Port, MaxGames, ?START_DELAY, false). + +test(Host, Port, MaxGames, Delay) -> + test(Host, Port, MaxGames, Delay, false). + +test(Host, Port, MaxGames, Delay, Trace) + when is_list(Host), is_number(Port); + is_atom(Host), is_number(Port) -> + io:format("Simulating gameplay...~n"), + DB = opendb(), + {ok, MultiBot} = start(), + erlang:monitor(process, MultiBot), + T1 = erlang:now(), + Key = dets:first(DB), + spawn(fun() -> test(DB, Key, MultiBot, MaxGames, + Host, Port, Trace, Delay) end), + io:format("Waiting for game to end...~n"), + receive + {'DOWN', _, _, MultiBot, normal} -> + T2 = erlang:now(), + Elapsed = timer:now_diff(T2, T1) / 1000 / 1000, + io:format("MultiBot exited, ~w seconds elapsed~n", + [Elapsed]); + Other -> + erlang:display(Other) + end. + +test(DB, '$end_of_table', _MultiBot, _Max, _Host, _Port, _Trace, _Delay) -> + closedb(DB); + +test(DB, _Key, _MultiBot, 0, _Host, _Port, _Trace, _Delay) -> + closedb(DB); + +test(DB, Key, MultiBot, Max, Host, Port, Trace, Delay) -> + %%F = fun() -> + {Host1, Port1} = find_server(Host, Port), + [Game] = dets:lookup(DB, Key), + Game1 = fix_nicks(Game), + update_players(Game1), + gen_server:cast(MultiBot, {'RUN', Game1, Host1, Port1, Trace, Delay}), + %% end, + %%spawn(F), + Key1 = dets:next(DB, Key), + test(DB, Key1, MultiBot, Max - 1, Host, Port, Trace, Delay). + +setup_players(Game, GID, Host, Port) -> + Players = lists:reverse(tuple_to_list(Game#irc_game.players)), + setup_players(Game#test_game.irc_id, GID, Host, Port, + Players, size(Game#irc_game.players), []). + +setup_players(_IRC_ID, _GID, _Host, _Port, _Players, 0, Acc) -> + Acc; + +setup_players(IRC_ID, GID, Host, Port, [Player|Rest], N, Acc) -> + %% start bot + {ok, Bot} = bot:start(IRC_ID, Player#irc_player.nick, + N, Player#irc_player.balance), + Nick = Player#irc_player.nick, + Pass = "foo", + ok = gen_server:call(Bot, {'CONNECT', Host, Port}, 15000), + gen_server:cast(Bot, {'SET ACTIONS', Player#irc_player.actions}), + gen_server:cast(Bot, {?PP_LOGIN, Nick, Pass}), + gen_server:cast(Bot, {?PP_WATCH, GID}), + setup_players(IRC_ID, GID, Host, Port, Rest, N - 1, [{Bot, N}|Acc]). + +ircdb_nicks(Game) -> + Players = Game#irc_game.players, + ircdb_nicks(Players, size(Players), erlang:make_tuple(size(Players), none)). + +ircdb_nicks(_Players, 0, Tuple) -> + Tuple; + +ircdb_nicks(Players, Count, Tuple) -> + Player = element(Count, Players), + Nick = list_to_atom(Player#irc_player.nick), + Tuple1 = setelement(Count, Tuple, Nick), + ircdb_nicks(Players, Count - 1, Tuple1). + +fixup_winners(Game, Winners) -> + fixup_winners(Game, gb_trees:to_list(Winners), gb_trees:empty()). + +fixup_winners(Game, [{SeatNum, Amount}|Rest], Tree) -> + Nick = element(SeatNum, Game#test_game.nicks), + fixup_winners(Game, Rest, gb_trees:insert(Nick, Amount, Tree)); + +fixup_winners(_Game, [], Tree) -> + Tree. + +ircdb_winners(Game) -> + Players = Game#irc_game.players, + ircdb_winners(Players, size(Players), gb_trees:empty()). + +ircdb_winners(_Players, 0, Tree) -> + Tree; + +ircdb_winners(Players, Count, Tree) -> + Player = element(Count, Players), + Nick = list_to_atom(Player#irc_player.nick), + Win = Player#irc_player.win, + if + Win /= 0 -> + NewTree = gb_trees:insert(Nick, Win, Tree); + true -> + NewTree = Tree + end, + ircdb_winners(Players, Count - 1, NewTree). + +match_winners(Tree1, Tree2) -> + Keys1 = gb_trees:keys(Tree1), + Keys2 = gb_trees:keys(Tree2), + Values1 = gb_trees:values(Tree1), + Values2 = gb_trees:values(Tree2), + if + Keys1 /= Keys2 -> + false; + true -> + match_win_amounts(Values1, Values2) + end. + +match_win_amounts([], []) -> + true; + +match_win_amounts([Amt1|Rest1], [Amt2|Rest2]) -> + Delta = abs(Amt1 - Amt2), + if + Delta >= 2 -> + false; + true -> + match_win_amounts(Rest1, Rest2) + end. + +remove(GameId) -> + {ok, Dets} = dets:open_file(ircdb, [{file, "ircdb.dat"}, + {keypos, 2}]), + dets:delete(Dets, GameId), + dets:close(Dets). + +print(GameId) -> + {ok, Dets} = dets:open_file(ircdb, [{file, "ircdb.dat"}, + {keypos, 2}]), + [Game] = dets:lookup(Dets, GameId), + io:format("~w~n", [Game]), + dets:close(Dets). + +filter() -> + {ok, Dets} = dets:open_file(ircdb, [{file, "ircdb.dat"}, + {keypos, 2}]), + Props1 = dets:info(Dets), + Count1 = fetch_prop(size, Props1), + dets:traverse(Dets, fun filter/1), + Props2 = dets:info(Dets), + Count2 = fetch_prop(size, Props2), + io:format("~w records~n", [Count2]), + io:format("~w records removed~n", [Count1 - Count2]), + dets:close(Dets). + +count() -> + {ok, Dets} = dets:open_file(ircdb, [{file, "ircdb.dat"}, + {keypos, 2}]), + Props = dets:info(Dets), + Count = fetch_prop(size, Props), + io:format("~w records~n", [Count]), + dets:close(Dets). + +filter(Game) -> + Match1 = match1(Game), + Match2 = match2(Game), + Match3 = match3(Game), + if + Match1 or Match2 or Match3 -> + remove(Game#irc_game.id); + true -> + ok + end, + continue. + +%% 531 removed from 199504 + +match1(Game) -> + Player1 = element(1, Game#irc_game.players), + Player2 = element(2, Game#irc_game.players), + Action1 = hd(Player1#irc_player.actions), + Action2 = hd(Player2#irc_player.actions), + (Action1 == 'BLIND') and (Action2 /= 'BLIND'). + +%% 2677 removed from 199504 + +match2(Game) -> + Count = size(Game#irc_game.players), + if + Count == 2 -> + Player1 = element(1, Game#irc_game.players), + Player2 = element(2, Game#irc_game.players), + Action1 = lists:nth(2, Player1#irc_player.actions), + Action2 = lists:nth(2, Player2#irc_player.actions), + (Action1 == 'FOLD') or (Action2 == 'FOLD'); + true -> + false + end. + +%% 2044 removed from 199504 + +match3(Game) -> + Count = size(Game#irc_game.players), + if + Count == 2 -> + Player1 = element(1, Game#irc_game.players), + Player2 = element(2, Game#irc_game.players), + Cards1 = Player1#irc_player.cards, + Cards2 = Player2#irc_player.cards, + (Cards1 == []) and (Cards2 == []); + true -> + false + end. + +%% match4(Game) -> +%% L = [798042078, +%% 797798880, +%% 797884001, +%% 798096936, +%% 798363468, +%% 798347270, +%% 798044596, +%% 797613326, +%% 798103907, +%% 797999395, +%% 797669462, +%% 797883424, +%% 797560316, +%% 797734988, +%% 797696540 +%% ], +%% false. + +fetch_prop(_Prop, []) -> + none; + +fetch_prop(Prop, [{Key, Value}|T]) -> + if + Key == Prop -> + Value; + true -> + fetch_prop(Prop, T) + end. + +setup_observer(Parent, GID, Host, Port, Trace) -> + %% setup observer bot + {ok, Observer} = observer:start(Parent), + gen_server:cast(Observer, {'TRACE', Trace}), + %% watch game + ok = gen_server:call(Observer, {'CONNECT', Host, Port}, 15000), + gen_server:cast(Observer, {?PP_WATCH, GID}), + Observer. + +find_server(Host, Port) -> + Parent = self(), + F = fun() -> + case tcp_server:start_client(Host, Port, 1024) of + {ok, Sock} -> + Result = find_server(Sock), + ok = gen_tcp:close(Sock), + Parent ! {find_server, Result}; + {error, Reason} -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {where, find_server}, + {self, self()}, + {message, Reason}]), + Parent ! {find_server, none}; + Any -> + Parent ! {find_server, Any} + end + end, + spawn(F), + receive + {find_server, Result} -> + Result + after 12000 -> + timeout1 + end. + +find_server(Sock) -> + receive + {tcp, Sock, Bin} -> + case proto:read(Bin) of + {?PP_HANDOFF, Port, Host} -> + %%io:format("Gotta go to ~s:~w~n", [Host, Port]), + {Host, Port} + end; + {error, closed} -> + io:format("Error retrieving gateway reply~n"), + none; + Any -> + io:format("find_server: received ~w~n", [Any]), + find_server(Sock) + after 100000 -> + io:format("find_server: timeout, exiting~n"), + none + end. + +rig_deck(Game) -> + {ok, Deck} = deck:start(), + Players = Game#irc_game.players, + Count = size(Players), + Cards1 = player_cards(Players, Deck, 1, Count, []), + Cards2 = player_cards(Players, Deck, 2, Count, []), + %%io:format("Cards1: ~w~n", [Cards1]), + %%io:format("Cards2: ~w~n", [Cards2]), + Cards = Cards1 ++ Cards2 ++ Game#irc_game.board, + deck:stop(Deck), + Cards. + +player_cards(_Players, _Deck, _N, 0, Acc) -> + Acc; + +player_cards(Players, Deck, N, Count, Acc) -> + Player = element(Count, Players), + Card = if + length(Player#irc_player.cards) < N -> + %%Nick = Player#irc_player.nick, + %%io:format("~s has ~w~n", [Nick, Player#irc_player.cards]), + %%io:format("No card at round ~w, drawing from deck~n", + %% [N]), + gen_server:call(Deck, 'DRAW'); + true -> + X = lists:nth(N, Player#irc_player.cards), + %%Nick = Player#irc_player.nick, + %%io:format("Dealing ~w to ~s~n", + %% [X, Nick]), + X + end, + player_cards(Players, Deck, N, Count - 1, [Card|Acc]). + +setup(Host) -> + multibot:cleanup(), + timer:sleep(1000), + %% start server in test mode + %% to enable starting of test games + server:start(Host, 2000, true), + gateway:start(node(), 3000, 500000), + ok. + +cleanup() -> + mnesia:start(), + case mnesia:wait_for_tables([game_config], 10000) of + ok -> + io:format("multibot:cleanup: deleting game info...~n"), + db:delete(game_xref), + %%io:format("multibot:cleanup: deleting player info...~n"), + %%db:delete(player), + %%counter:reset(player), + counter:reset(game), + db:set(cluster_config, 0, {enable_dynamic_games, true}); + Any -> + io:format("multibot:cleanup: mnesia error ~w~n", [Any]) + end, + ok. + +fix_nicks(Game) -> + Players = Game#irc_game.players, + Size = size(Players), + Game#irc_game { + players = fix_nicks(Game#irc_game.id, Players, Size) + }. + +fix_nicks(_Id, Players, 0) -> + Players; + +fix_nicks(Id, Players, Size) -> + Player = element(Size, Players), + Player1 = Player#irc_player { + nick = Player#irc_player.nick + ++ [$/] ++ integer_to_list(Id) + }, + Players1 = setelement(Size, Players, Player1), + fix_nicks(Id, Players1, Size - 1). + +start_game(Host, Port, Game, Delay) + when is_record(Game, irc_game) -> + Parent = self(), + Cards = rig_deck(Game), + Packet = {?GT_IRC_TEXAS, + Game#irc_game.player_count, + {?LT_FIXED_LIMIT, 10, 20}, + Delay, % game start delay + ?PLAYER_TIMEOUT, + Cards}, + F = fun() -> + case tcp_server:start_client(Host, Port, 1024) of + {ok, Sock} -> + Result = start_game(Sock, Packet), + ok = gen_tcp:close(Sock), + Parent ! {start_game, Result}; + {error, Reason} -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {where, start_game}, + {self, self()}, + {message, Reason}]), + Parent ! {start_game, none}; + Any -> + Parent ! {start_game, Any} + end + end, + spawn(F), + receive + {start_game, Result} -> + Result + after 12000 -> + start_game_timeout + end. + +start_game(Sock, Packet) -> + L = [?PP_MAKE_TEST_GAME] ++ binary_to_list(term_to_binary(Packet)), + Bin = list_to_binary(L), + ok = gen_tcp:send(Sock, Bin), + receive + {tcp, Sock, Bin1} -> + case proto:read(Bin1) of + {?PP_GOOD, ?PP_MAKE_TEST_GAME, GID} -> + GID; + Any -> + {error, Any} + end; + {error, closed} -> + io:format("Error retrieving server reply~n"), + none; + Any -> + io:format("start_game: received ~w~n", [Any]), + start_game(Sock, Packet) + after 100000 -> + io:format("start_game: timeout, exiting~n"), + none + end. diff --git a/openpoker-server/src/observer.erl b/openpoker-server/src/observer.erl new file mode 100644 index 0000000..0d7e857 --- /dev/null +++ b/openpoker-server/src/observer.erl @@ -0,0 +1,382 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(observer). +-behaviour(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). + +-export([start/1, stop/1]). + +-include("test.hrl"). +-include("common.hrl"). +-include("proto.hrl"). + +-record(data, { + oid, + trace, + parent, + gid, + player, + socket, + winners, + seats + }). + +new(Parent) -> + #data { + trace = false, + parent = Parent, + player = none, + socket = none, + winners = gb_trees:empty(), + seats = gb_trees:empty() + }. + +start(Parent) -> + gen_server:start(observer, [Parent], []). + +init([Parent]) -> + process_flag(trap_exit, true), + {ok, new(Parent)}. + +stop(Ref) -> + gen_server:cast(Ref, stop). + +terminate(_Reason, Data) -> + case Data#data.socket of + none -> + ignore; + Socket -> + gen_tcp:close(Socket) + end, + ok. + +handle_cast({'ID', OID}, Data) -> + Data1 = Data#data { + oid = OID + }, + {noreply, Data1}; + +handle_cast({'TRACE', On}, Data) -> + Data1 = Data#data { + trace = On + }, + {noreply, Data1}; + +handle_cast(stop, Data) -> + {stop, normal, Data}; + +handle_cast(Event, Data) -> + ok = ?tcpsend(Data#data.socket, Event), + {noreply, Data}. + +handle_call({'CONNECT', Host, Port}, _From, Data) -> + {ok, Sock} = tcp_server:start_client(Host, Port, 1024), + Data1 = Data#data { + socket = Sock + }, + {reply, ok, Data1}; + +handle_call('ID', _From, Data) -> + {reply, Data#data.oid, Data}; + +handle_call(Event, From, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {from, From}, + {message, Event}]), + {noreply, Data}. + +handle_info({tcp_closed, _Socket}, Data) -> + {stop, normal, Data}; + +handle_info({tcp, _Socket, <>}, Data) -> + Data1 = Data#data { + player = PID + }, + {noreply, Data1}; + +handle_info({tcp, _Socket, Bin}, Data) -> + case proto:read(Bin) of + none -> + {noreply, Data}; + Event -> + handle(Event, Data) + end; + +handle_info({'EXIT', _Pid, _Reason}, Data) -> + %% child exit? + {noreply, Data}; + +handle_info(Info, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Info}]), + {noreply, Data}. + +code_change(_OldVsn, Data, _Extra) -> + {ok, Data}. + +handle({?PP_GAME_INFO, GID, ?GT_IRC_TEXAS, + Expected, Joined, Waiting, + {?LT_FIXED_LIMIT, Low, High}}, Data) -> + if + Data#data.trace -> + io:format("Game #~w, #players: ~w, joined: ~w, waiting: ~w; ", + [GID, Expected, Joined, Waiting]), + io:format("limit: low: ~w, high: ~w~n", [Low, High]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_PLAYER_INFO, PID, InPlay, Nick, Location}, Data) -> + if + Data#data.trace -> + io:format("Player: #~w, in-play: ~w, nick: ~w, location: ~w~n", + [PID, InPlay, Nick, Location]), + Amount = gb_trees:get(PID, Data#data.winners), + T1 = gb_trees:delete(PID, Data#data.winners), + Nick1 = list_to_atom(Nick), + io:format("Observer: Nick: ~w, Amount: ~w~n", [Nick1, Amount]), + Data1 = Data#data { + winners = gb_trees:insert(Nick1, Amount, T1) + }, + {noreply, Data1}; + true -> + {noreply, Data} + end; + +handle({?PP_NOTIFY_JOIN, GID, PID, SeatNum, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: JOIN: ~w at seat#~w~n", + [GID, PID, SeatNum]); + true -> + ok + end, + Data1 = Data#data { + seats = gb_trees:insert(PID, SeatNum, Data#data.seats) + }, + {noreply, Data1}; + +handle({?PP_NOTIFY_CHAT, GID, PID, _Seq, Message}, Data) -> + if + Data#data.trace -> + io:format("~w: CHAT: ~w: ~s~n", + [GID, PID, Message]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_PLAYER_STATE, GID, PID, State, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: STATE: ~w = ~w~n", + [GID, PID, State]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_LEAVE, GID, PID, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: LEAVE: ~w~n", + [GID, PID]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_PRIVATE, GID, PID, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: CARD: ~w~n", + [GID, PID]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_GAME_STAGE, GID, Stage, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: STAGE: ~w~n", + [GID, Stage]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_BET, GID, PID, Amount, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: BET: ~w, ~-14.2. f~n", + [GID, PID, Amount]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_CALL, GID, PID, Amount, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: CALL: ~w, ~-14.2. f~n", + [GID, PID, Amount]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_RAISE, GID, PID, Amount, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: RAISE: ~w, ~-14.2. f~n", + [GID, PID, Amount]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_SB, GID, PID, Amount, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: SB: ~w, ~-14.2. f~n", + [GID, PID, Amount]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_BB, GID, PID, Amount, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: BB: ~w, ~-14.2. f~n", + [GID, PID, Amount]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_SHARED, GID, {Face, Suit}, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: BOARD: {~w, ~w}~n", + [GID, Face, Suit]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_WIN, GID, PID, Amount, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: WIN: ~w, ~-14.2. f~n", + [GID, PID, Amount]); + true -> + ok + end, + SeatNum = gb_trees:get(PID, Data#data.seats), + Data1 = Data#data { + winners = gb_trees:insert(SeatNum, + Amount, + Data#data.winners) + }, + {noreply, Data1}; + +handle({?PP_NOTIFY_START_GAME, GID, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: START~n", [GID]); + true -> + ok + end, + Data#data.parent ! {'START', GID}, + {noreply, Data}; + +handle({?PP_NOTIFY_BUTTON, GID, SeatNum, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: DEALER: seat#~w~n", [GID, SeatNum]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_SB, GID, SeatNum, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: SB: seat#~w~n", [GID, SeatNum]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_BB, GID, SeatNum, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: BB: seat#~w~n", [GID, SeatNum]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_CANCEL_GAME, GID, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: CANCEL~n", [GID]); + true -> + ok + end, + {noreply, Data}; + +handle({?PP_NOTIFY_END_GAME, GID, _Seq}, Data) -> + if + Data#data.trace -> + io:format("~w: END~n", [GID]); + true -> + ok + end, + Data#data.parent ! {'END', GID, Data#data.winners}, + ok = ?tcpsend(Data#data.socket, {?PP_UNWATCH, GID}), + {stop, normal, Data}; + +handle({?PP_GOOD, _, _}, Data) -> + {noreply, Data}; + +%% Sink + +handle(Event, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {event, Event}]), + {noreply, Data}. + + + + diff --git a/openpoker-server/src/player.erl b/openpoker-server/src/player.erl new file mode 100644 index 0000000..2aebdb9 --- /dev/null +++ b/openpoker-server/src/player.erl @@ -0,0 +1,302 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(player). +-behaviour(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). +-export([start/1, stop/1, cast/2, call/2, test/0]). +-export([create/4]). + +-include("test.hrl"). +-include("common.hrl"). +-include("proto.hrl"). +-include("schema.hrl"). + +-record(data, { + oid, + socket = none, + inplay = 0 + }). + +new(OID) -> + #data { + oid = OID + }. + +start(Nick) + when is_list(Nick) -> + gen_server:start(player, [Nick], []). + +init([Nick]) + when is_list(Nick) -> + process_flag(trap_exit, true), + %% make sure we exist + case db:find(player, nick, Nick) of + {atomic, [Player]} -> + %% update process id + OID = Player#player.oid, + case db:set(player, OID, {pid, self()}) of + {atomic, ok} -> + %% all good + {ok, new(OID)}; + Any -> + {stop, Any} + end; + Any -> + {stop, Any} + end. + +stop(Player) + when is_pid(Player) -> + gen_server:cast(Player, stop). + +terminate(_Reason, Data) -> + db:set(player, Data#data.oid, {pid, none}), + ok. + +handle_cast('LOGOUT', Data) -> + spawn(fun() -> + login:logout(Data#data.oid) + end), + {noreply, Data}; + +handle_cast('DISCONNECT', Data) -> + %% ignore + {noreply, Data}; + +handle_cast({'SOCKET', Socket}, Data) + when is_pid(Socket) -> + Data1 = Data#data { + socket = Socket + }, + {noreply, Data1}; + +handle_cast({'INPLAY-', Amount}, Data) + when is_number(Amount), Amount >= 0 -> + %%db:dec(player, Data#data.oid, {inplay, Amount}), + Data1 = Data#data { + inplay = Data#data.inplay - Amount + }, + {noreply, Data1}; + +handle_cast({'INPLAY+', Amount}, Data) + when is_number(Amount), Amount > 0 -> + %%db:dec(player, Data#data.oid, {inplay, Amount}), + Data1 = Data#data { + inplay = Data#data.inplay + Amount + }, + {noreply, Data1}; + +handle_cast({?PP_WATCH, Game}, Data) + when is_pid(Game) -> + cardgame:cast(Game, {?PP_WATCH, self()}), + {noreply, Data}; + +handle_cast({?PP_UNWATCH, Game}, Data) + when is_pid(Game) -> + cardgame:cast(Game, {?PP_UNWATCH, self()}), + {noreply, Data}; + +handle_cast({Event, Game, Amount}, Data) + when Event == ?PP_CALL; + Event == ?PP_RAISE -> + cardgame:send_event(Game, {Event, self(), Amount}), + {noreply, Data}; + +handle_cast({?PP_JOIN, Game, SeatNum, BuyIn}, Data) -> + cardgame:send_event(Game, {?PP_JOIN, self(), SeatNum, BuyIn}), + {noreply, Data}; + +handle_cast({?PP_LEAVE, Game}, Data) -> + cardgame:send_event(Game, {?PP_LEAVE, self()}), + %% move inplay amount back to balance + {atomic, ok} = db:set(player, + Data#data.oid, + {inplay, Data#data.inplay}), + {atomic, ok} = db:move_amt(player, + Data#data.oid, + {inplay, balance, Data#data.inplay}), + Data1 = Data#data { + inplay = 0 + }, + {noreply, Data1}; + +handle_cast({Event, Game}, Data) + when Event == ?PP_FOLD; + Event == ?PP_SIT_OUT; + Event == ?PP_COME_BACK -> + cardgame:send_event(Game, {Event, self()}), + {noreply, Data}; + +handle_cast({?PP_CHAT, Game, Message}, Data) -> + cardgame:cast(Game, {?PP_CHAT, self(), Message}), + {noreply, Data}; + +handle_cast({?PP_SEAT_QUERY, Game}, Data) -> + GID = cardgame:call(Game, 'ID'), + L = cardgame:call(Game, 'SEAT QUERY'), + F = fun({SeatNum, State, Player}) -> + PID = if + Player == self() -> + Data#data.oid; + State /= ?SS_EMPTY -> + gen_server:call(Player, 'ID'); + true -> + 0 + end, + handle_cast({?PP_SEAT_STATE, GID, SeatNum, State, PID}, Data) + end, + lists:foreach(F, L), + {noreply, Data}; + +handle_cast({?PP_PLAYER_INFO_REQ, PID}, Data) -> + case db:find(player, PID) of + {atomic, [Player]} -> + handle_cast({?PP_PLAYER_INFO, + Player#player.pid, + Player#player.inplay, + Player#player.nick, + Player#player.location}, Data); + _ -> + oops + end, + {noreply, Data}; + +handle_cast({?PP_NEW_GAME_REQ, GameType, Expected, Limit}, Data) -> + {atomic, DynamicGames} = db:get(cluster_config, 0, enable_dynamic_games), + if + DynamicGames -> + case cardgame:start(GameType, Expected, Limit) of + {ok, Pid} -> + GID = cardgame:call(Pid, 'ID'), + handle_cast({?PP_GOOD, ?PP_NEW_GAME_REQ, GID}, Data); + _ -> + handle_cast({?PP_BAD, ?PP_NEW_GAME_REQ, ?ERR_UNKNOWN}, Data) + end; + true -> + handle_cast({?PP_BAD, ?PP_NEW_GAME_REQ, ?ERR_START_DISABLED}, Data) + end, + {noreply, Data}; + +handle_cast(?PP_BALANCE_REQ, Data) -> + case db:find(player, Data#data.oid) of + {atomic, [Player]} -> + handle_cast({?PP_BALANCE_INFO, + Player#player.balance, + Player#player.inplay}, Data); + _ -> + oops + end, + {noreply, Data}; + +handle_cast(stop, Data) -> + {stop, normal, Data}; + +handle_cast(Event, Data) -> + if + Data#data.socket /= none -> + Data#data.socket ! {packet, Event}; + true -> + ok + end, + {noreply, Data}. + +handle_call('ID', _From, Data) -> + {reply, Data#data.oid, Data}; + +handle_call('INPLAY', _From, Data) -> + {reply, Data#data.inplay, Data}; + +handle_call(Event, From, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Event}, + {from, From}]), + {noreply, Data}. + +handle_info({'EXIT', _Pid, _Reason}, Data) -> + %% child exit? + {noreply, Data}; + +handle_info(Info, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Info}]), + {noreply, Data}. + +code_change(_OldVsn, Data, _Extra) -> + {ok, Data}. + +%%% +%%% Utility +%%% + +cast(PID, Event) -> + case db:find(player, PID) of + {atomic, [Player]} -> + gen_server:cast(Player#player.pid, Event); + _ -> + none + end. + +call(PID, Event) -> + case db:find(player, PID) of + {atomic, [Player]} -> + gen_server:call(Player#player.pid, Event); + _ -> + none + end. + +create(Nick, Pass, Location, Balance) + when is_list(Nick), + is_list(Pass), + is_list(Location), + is_number(Balance) -> + OID = counter:bump(player), + Player = #player { + oid = OID, + nick = Nick, + %% store a hash of the password + %% instead of the password itself + password = erlang:phash2(Pass, 1 bsl 32), + location = Location, + balance = Balance, + inplay = 0.00 + }, + mnesia:transaction(fun() -> + mnesia:write(Player), + OID + end). + +%%% +%%% Test suite +%%% + +test() -> + ok. + + + + diff --git a/openpoker-server/src/pot.erl b/openpoker-server/src/pot.erl new file mode 100644 index 0000000..24a097e --- /dev/null +++ b/openpoker-server/src/pot.erl @@ -0,0 +1,536 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(pot). +-behaviour(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). + +-export([start/0, start_link/0, stop/1, test/0]). + +-include("test.hrl"). + +-record(side_pot, { + members, + all_in + }). + +-record(pot, { + active = [], + inactive = [], + current = new_side_pot() + }). + +new_side_pot(AllInAmt, Members) -> + SidePot = #side_pot{ + all_in = AllInAmt, + members = Members + }, + SidePot. + +new_side_pot(AllInAmt) when number(AllInAmt) -> + new_side_pot(AllInAmt, gb_trees:empty()); + +new_side_pot(Pot) when record(Pot, side_pot) -> + new_side_pot(Pot#side_pot.all_in, Pot#side_pot.members). + +new_side_pot() -> + new_side_pot(0, gb_trees:empty()). + +new_pot() -> + #pot {}. + +start() -> + gen_server:start(pot, [], []). + +start_link() -> + gen_server:start_link(pot, [], []). + +init(_) -> + process_flag(trap_exit, true), + {ok, new_pot()}. + +stop(PotRef) -> + gen_server:cast(PotRef, stop). + +terminate(normal, _Pot) -> + ok. + +handle_cast('RESET', _Pot) -> + {noreply, new_pot()}; + +handle_cast('NEW STAGE', Pot) -> + Inactive = Pot#pot.inactive + ++ Pot#pot.active + ++ [Pot#pot.current], + NewPot = Pot#pot { + active = [], + inactive = Inactive, + current = new_side_pot() + }, + {noreply, NewPot}; + +handle_cast({'SPLIT', Player, Amount}, Pot) -> + {noreply, split(Pot, Player, Amount)}; + +handle_cast(stop, Pot) -> + {stop, normal, Pot}; + +handle_cast({'ADD BET', Player, Amount, IsAllIn}, Pot) -> + {NewPot, 0} = add_bet(Pot, Player, Amount, IsAllIn), + {noreply, NewPot}; + +handle_cast(Event, Pot) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {pot, self()}, + {message, Event}]), + {noreply, Pot}. + +handle_call('SIDE POTS', _From, Pot) -> + Pots = [{total(P), P#side_pot.members} || P <- side_pots(Pot)], + {reply, Pots, Pot}; + +handle_call('TOTAL', _From, Pot) -> + {reply, total(Pot), Pot}; + +handle_call(Event, From, Pot) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {pot, self()}, + {message, Event}, + {from, From}]), + {noreply, Pot}. + +handle_info({'EXIT', _Pid, _Reason}, Pot) -> + %% child exit? + {noreply, Pot}; + +handle_info(Info, Pot) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {pot, self()}, + {message, Info}]), + {noreply, Pot}. + +code_change(_OldVsn, Pot, _Extra) -> + {ok, Pot}. + +%% +%% Utility +%% + +%% Ensure that player belongs to the pot + +make_member(Pot, Player) -> + case gb_trees:lookup(Player, Pot#side_pot.members) of + {value, Bet } -> + {Pot, Bet}; + _ -> + Members = gb_trees:insert(Player, 0, Pot#side_pot.members), + NewPot = Pot#side_pot { + members = Members + }, + {NewPot, 0} + end. + +%% Add up to all-in amount if pot is split +%% and simply assign the amount if not + +add_bet(Pot, Player, Amount) when record(Pot, side_pot) -> + {NewPot, Bet} = make_member(Pot, Player), + AllIn = NewPot#side_pot.all_in, + {Unallocated, Members} = + if + AllIn > 0 -> + %% Pot is split, figure out + %% the difference between amount bet + %% so far and the all-in amount + Delta = AllIn - Bet, + if + Delta > 0 -> + %% Post all-in + U = Amount - Delta, + M = gb_trees:enter(Player, AllIn, Pot#side_pot.members), + {U, M}; + true -> + %% Posted enough already + {Amount, Pot#side_pot.members} + end; + true -> + %% Pot is not split, post Amount + M = update_counter(Player, Amount, Pot#side_pot.members), + {0, M} + end, + NewPot1 = NewPot#side_pot{ + members = Members + }, + {NewPot1, Unallocated}; + +add_bet(Pot, Player, Amount) when record(Pot, pot) -> + add_bet(Pot, Player, Amount, false). + +add_bet(Pot, Player, Amount, IsAllIn) when record(Pot, pot) -> + %% add to prior pots as needed + {Active, Unallocated} = allocate_bet(Pot#pot.active, Player, Amount), + Pot1 = Pot#pot { + active = Active + }, + if + IsAllIn -> + %% split the pot + Pot2 = split(Pot1, Player, Unallocated), + Rest = 0; + true -> + {Current, Rest} = add_bet(Pot1#pot.current, Player, Unallocated), + Pot2 = Pot1#pot { + current = Current + } + end, + {Pot2, Rest}. + +allocate_bet(SidePots, Player, Amount) when list(SidePots) -> + lists:mapfoldl(fun(Pot, Unallocated) -> + add_bet(Pot, Player, Unallocated) + end, + Amount, SidePots). + +side_pots(Pot) -> + Temp = lists:append(Pot#pot.active, Pot#pot.inactive), + Current = Pot#pot.current, + lists:filter(fun(P) -> + gb_trees:size(P#side_pot.members) > 0 + andalso total(P) > 0 + end, [Current|Temp]). + +total(Pot) when record(Pot, side_pot) -> + F = fun(X, Acc) -> X + Acc end, + lists:foldl(F, 0, gb_trees:values(Pot#side_pot.members)); + +total(Pot) when record(Pot, pot) -> + F = fun(X, Acc) -> + Acc + total(X) + end, + lists:foldl(F, 0, side_pots(Pot)). + +%% Split the pot. Last bet for this player plus +%% the current bet becomes the all-in amount. +%% Bets in excess of the all-in amount are moved +%% to a new side pot. + +split(Pot, Player, Amount) when record(Pot, pot) -> + {OldPot, NewPot} = split(Pot#pot.current, Player, Amount), + Active = lists:append(Pot#pot.active, [OldPot]), + Pot#pot { + current = NewPot, + active = Active + }; + +split(SidePot, Player, Amount) -> + M = update_counter(Player, Amount, SidePot#side_pot.members), + SidePot1 = SidePot#side_pot { + members = M + }, + Members1 = SidePot1#side_pot.members, + Bet = gb_trees:get(Player, Members1), + List = gb_trees:to_list(Members1), + List1 = lists:filter(fun({Key, Value}) -> + (Key /= Player) and (Value > Bet) + end, List), + List2 = lists:map(fun({Key, Value}) -> + {Key, Value - Bet} + end, List1), + NewPot = #side_pot { + all_in = 0, + members = gb_trees:from_orddict(List2) + }, + Members2 = lists:map(fun({Key, Value}) -> + if + Value > Bet -> {Key, Bet}; + true -> {Key, Value} + end + end, List), + OldPot = SidePot1#side_pot { + all_in = Bet, + members = gb_trees:from_orddict(Members2) + }, + {OldPot, NewPot}. + +update_counter(Key, Amount, Tree) -> + case gb_trees:lookup(Key, Tree) of + {value, Old} -> + Old = gb_trees:get(Key, Tree), + gb_trees:update(Key, Old + Amount, Tree); + none -> + gb_trees:insert(Key, Amount, Tree) + end. + +%%% +%%% Test suite +%%% + +is_member(Pot, Player) when record(Pot, side_pot) -> + gb_trees:is_defined(Player, Pot#side_pot.members). + +test() -> + test1(), + test2(), + test3(), + test4(), + test5(), + test6(), + test7(), + test8(), + test9(), + test10(), + test11(), + test12(), + test13(). + +%% Pot is split, Delta > 0 + +test1() -> + Pot = new_side_pot(100), + {NewPot, Amount} = add_bet(Pot, 'P', 120), + ?match(20, Amount), + ?match(true, is_member(NewPot, 'P')), + ?match(100, total(NewPot)). + +%% Pot is split, Delta <= 0 + +test2() -> + Pot = new_side_pot(100), + {NewPot, Amount} = add_bet(Pot, 'P', 100), + ?match(0, Amount), + ?match(true, is_member(NewPot, 'P')), + ?match(100, total(NewPot)). + +%% Pot is not split + +test3() -> + Pot = new_side_pot(), + {NewPot, Amount} = add_bet(Pot, 'P', 100), + ?match(0, Amount), + ?match(true, is_member(NewPot, 'P')), + ?match(100, total(NewPot)), + {NewPot1, Amount1} = add_bet(NewPot, 'P', 100), + ?match(0, Amount1), + ?match(200, total(NewPot1)). + +%% Split pot + +test4() -> + Pot = new_side_pot(), + Pot1 = Pot#side_pot { + members = gb_trees:insert('A', 10, Pot#side_pot.members) + }, + Pot2 = Pot1#side_pot { + members = gb_trees:insert('B', 30, Pot1#side_pot.members) + }, + Pot3 = Pot2#side_pot { + members = gb_trees:insert('C', 40, Pot2#side_pot.members) + }, + {NewPot, SidePot} = split(Pot3, 'A', 10), + ?match(20, NewPot#side_pot.all_in), + ?match(20, gb_trees:get('A', NewPot#side_pot.members)), + ?match(20, gb_trees:get('B', NewPot#side_pot.members)), + ?match(20, gb_trees:get('C', NewPot#side_pot.members)), + ?match(0, SidePot#side_pot.all_in), + ?match(10, gb_trees:get('B', SidePot#side_pot.members)), + ?match(20, gb_trees:get('C', SidePot#side_pot.members)), + ?match(false, is_member(SidePot, 'A')). + +%% % ;;; http://www.homepokertourney.com/allin_examples.htm + +test5() -> + Pot = new_pot(), + { Pot1, Amt1 } = add_bet(Pot, 'A', 100), + ?match(0, Amt1), + { Pot2, Amt2 } = add_bet(Pot1, 'B', 60, true), + ?match(0, Amt2), + ?match(40, total(Pot2#pot.current)), + ?match(true, is_member(Pot2#pot.current, 'A')), + ?match(false, is_member(Pot2#pot.current, 'B')), + ?match(120, total(hd(Pot2#pot.active))), + ?match(true, is_member(hd(Pot2#pot.active), 'A')), + ?match(true, is_member(hd(Pot2#pot.active), 'B')). + +test6() -> + Pot = new_pot(), + { Pot1, 0 } = add_bet(Pot, 'A', 100), + { Pot2, 0 } = add_bet(Pot1, 'B', 100), + { Pot3, 0 } = add_bet(Pot2, 'C', 60, true), + ?match(80, total(Pot3#pot.current)), + ?match(true, is_member(Pot3#pot.current, 'A')), + ?match(true, is_member(Pot3#pot.current, 'B')), + ?match(false, is_member(Pot3#pot.current, 'C')), + ?match(180, total(hd(Pot3#pot.active))), + ?match(true, is_member(hd(Pot3#pot.active), 'A')), + ?match(true, is_member(hd(Pot3#pot.active), 'B')), + ?match(true, is_member(hd(Pot3#pot.active), 'C')). + +test7() -> + Pot = new_pot(), + { Pot1, 0 } = add_bet(Pot, 'A', 100), + { Pot2, 0 } = add_bet(Pot1, 'B', 60, true), + { Pot3, 0 } = add_bet(Pot2, 'C', 100), + ?match(80, total(Pot3#pot.current)), + ?match(true, is_member(Pot3#pot.current, 'A')), + ?match(true, is_member(Pot3#pot.current, 'C')), + ?match(false, is_member(Pot3#pot.current, 'B')), + ?match(180, total(hd(Pot3#pot.active))), + ?match(true, is_member(hd(Pot3#pot.active), 'A')), + ?match(true, is_member(hd(Pot3#pot.active), 'B')), + ?match(true, is_member(hd(Pot3#pot.active), 'C')). + +test8() -> + Pot = new_pot(), + { Pot1, 0 } = add_bet(Pot, 'A', 100), + { Pot2, 0 } = add_bet(Pot1, 'B', 60, true), + { Pot3, 0 } = add_bet(Pot2, 'C', 100), + { Pot4, 0 } = add_bet(Pot3, 'D', 500), + { Pot5, 0 } = add_bet(Pot4, 'A', 250, true), + { Pot6, 0 } = add_bet(Pot5, 'C', 400), + %% there's a main pot between all 4 players + Side1 = lists:nth(1, Pot6#pot.active), + ?match(240, total(Side1)), + ?match(true, is_member(Side1, 'A')), + ?match(true, is_member(Side1, 'B')), + ?match(true, is_member(Side1, 'C')), + ?match(true, is_member(Side1, 'D')), + %% there's a side pot between a, c and d + Side2 = lists:nth(2, Pot6#pot.active), + ?match(870, total(Side2)), + ?match(true, is_member(Side2, 'A')), + ?match(true, is_member(Side2, 'C')), + ?match(true, is_member(Side2, 'D')), + ?match(false, is_member(Side2, 'B')), + %% there's another side pot between c and d + Side3 = Pot6#pot.current, + ?match(300, total(Side3)), + ?match(true, is_member(Side3, 'C')), + ?match(true, is_member(Side3, 'D')), + ?match(false, is_member(Side3, 'A')), + ?match(false, is_member(Side3, 'B')). + +test9() -> + Pot = new_pot(), + { Pot1, 0 } = add_bet(Pot, 'A', 10), + { Pot2, 0 } = add_bet(Pot1, 'B', 10), + { Pot3, 0 } = add_bet(Pot2, 'C', 7, true), + { Pot4, 0 } = add_bet(Pot3, 'D', 20), + { Pot5, 0 } = add_bet(Pot4, 'A', 10), + { Pot6, 0 } = add_bet(Pot5, 'B', 20), + { Pot7, 0 } = add_bet(Pot6, 'D', 10), + %% player-a folds but is still + %% member of the last side pot + Side = lists:last(Pot7#pot.active), + ?match(28, total(Side)), + ?match(true, is_member(Side, 'A')), + ?match(true, is_member(Side, 'B')), + ?match(true, is_member(Side, 'C')), + ?match(true, is_member(Side, 'D')), + Side1 = Pot7#pot.current, + ?match(59, total(Side1)), + ?match(true, is_member(Side1, 'A')), + ?match(true, is_member(Side1, 'B')), + ?match(true, is_member(Side1, 'D')), + ?match(false, is_member(Side1, 'C')). + +test10() -> + Pot = new_pot(), + { Pot1, 0 } = add_bet(Pot, 'A', 10), + { Pot2, 0 } = add_bet(Pot1, 'B', 10), + { Pot3, 0 } = add_bet(Pot2, 'C', 7, true), + { Pot4, 0 } = add_bet(Pot3, 'D', 20), + { Pot5, 0 } = add_bet(Pot4, 'A', 2, true), + { Pot6, 0 } = add_bet(Pot5, 'B', 20), + { Pot7, 0 } = add_bet(Pot6, 'D', 10), + Side = lists:nth(1, Pot7#pot.active), + ?match(28, total(Side)), + ?match(true, is_member(Side, 'A')), + ?match(true, is_member(Side, 'B')), + ?match(true, is_member(Side, 'C')), + ?match(true, is_member(Side, 'D')), + Side1 = lists:nth(2, Pot7#pot.active), + ?match(15, total(Side1)), + ?match(true, is_member(Side1, 'A')), + ?match(true, is_member(Side1, 'B')), + ?match(true, is_member(Side1, 'D')), + ?match(false, is_member(Side1, 'C')), + Side2 = Pot7#pot.current, + ?match(36, total(Side2)), + ?match(true, is_member(Side2, 'B')), + ?match(true, is_member(Side2, 'D')), + ?match(false, is_member(Side2, 'A')), + ?match(false, is_member(Side2, 'C')). + +test11() -> + Pot = new_pot(), + { Pot1, 0 } = add_bet(Pot, 'A', 5, true), + { Pot2, 0 } = add_bet(Pot1, 'B', 10), + { Pot3, 0 } = add_bet(Pot2, 'C', 8, true), + { Pot4, 0 } = add_bet(Pot3, 'D', 10), + Side = lists:nth(1, Pot4#pot.active), + ?match(20, total(Side)), + ?match(true, is_member(Side, 'A')), + ?match(true, is_member(Side, 'B')), + ?match(true, is_member(Side, 'C')), + ?match(true, is_member(Side, 'D')), + Side1 = lists:nth(2, Pot4#pot.active), + ?match(9, total(Side1)), + ?match(true, is_member(Side1, 'B')), + ?match(true, is_member(Side1, 'C')), + ?match(true, is_member(Side1, 'D')), + ?match(false, is_member(Side1, 'A')), + Side2 = Pot4#pot.current, + ?match(4, total(Side2)), + ?match(true, is_member(Side2, 'B')), + ?match(true, is_member(Side2, 'D')), + ?match(false, is_member(Side2, 'A')), + ?match(false, is_member(Side2, 'C')). + +test12() -> + Pot = new_pot(), + { Pot1, 0 } = add_bet(Pot, 'A', 10), + { Pot2, 0 } = add_bet(Pot1, 'B', 10), + { Pot3, 0 } = add_bet(Pot2, 'C', 7, true), + { Pot4, 0 } = add_bet(Pot3, 'D', 10), + Side = lists:last(Pot4#pot.active), + ?match(28, total(Side)), + ?match(true, is_member(Side, 'A')), + ?match(true, is_member(Side, 'B')), + ?match(true, is_member(Side, 'C')), + ?match(true, is_member(Side, 'D')), + Side2 = Pot4#pot.current, + ?match(9, total(Side2)), + ?match(true, is_member(Side2, 'A')), + ?match(true, is_member(Side2, 'B')), + ?match(true, is_member(Side2, 'D')), + ?match(false, is_member(Side2, 'C')). + +test13() -> + Pot = new_pot(), + { Pot1, 0 } = add_bet(Pot, 'A', 20), + { Pot2, 0 } = add_bet(Pot1, 'B', 10), + ?match(30, total(Pot2)). + diff --git a/openpoker-server/src/proto.erl b/openpoker-server/src/proto.erl new file mode 100644 index 0000000..c969078 --- /dev/null +++ b/openpoker-server/src/proto.erl @@ -0,0 +1,489 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(proto). + +-export([read/1, write/1, test/0]). + +-include("test.hrl"). +-include("common.hrl"). +-include("proto.hrl"). +-include("schema.hrl"). + +%%% Client -> Server + +read(<>) -> + {?PP_GOOD, Cmd, Extra}; + +read(<>) -> + {?PP_BAD, Cmd, Error}; + +read(<>) -> + {Nick, Bin1} = read_string(Bin), + {Pass, _} = read_string(Bin1), + {?PP_LOGIN, Nick, Pass}; + +read(<>) + when Cmd == ?PP_PING; + Cmd == ?PP_PONG; + Cmd == ?PP_LOGOUT; + Cmd == ?PP_BALANCE_REQ -> + Cmd; + +read(<>) -> + {Host, _} = read_string(Bin), + {?PP_HANDOFF, Port, Host}; + +read(<>) -> + {?PP_PID, PID}; + +read(<>) -> + case find_game(GID) of + Pid when is_pid(Pid) -> + {?PP_JOIN, Pid, SeatNum, BuyIn / 100}; + Any -> + io:format("JOIN ~w: ~w~n", [GID, Any]), + Any + end; + +read(<>) + when Cmd == ?PP_WATCH; + Cmd == ?PP_UNWATCH; + Cmd == ?PP_SIT_OUT; + Cmd == ?PP_COME_BACK; + Cmd == ?PP_FOLD; + Cmd == ?PP_LEAVE -> + case find_game(GID) of + Pid when is_pid(Pid) -> + {Cmd, Pid}; + Any -> + Any + end; + +read(<>) + when Cmd == ?PP_CALL; + Cmd == ?PP_RAISE -> + case find_game(GID) of + Pid when is_pid(Pid) -> + {Cmd, Pid, Amount / 100}; + Any -> + Any + end; + +read(<>) -> + {Message, _} = read_string(Bin), + case find_game(GID) of + Pid when is_pid(Pid) -> + {?PP_CHAT, Pid, Message}; + Any -> + Any + end; + +read(<>) -> + {?PP_GAME_QUERY, + GameType, LimitType, + ExpOp, Expected, + JoinOp, Joined, + WaitOp, Waiting}; + +read(<>) -> + case find_game(GID) of + Pid when is_pid(Pid) -> + {?PP_SEAT_QUERY, Pid}; + Any -> + io:format("PLAYER_QUERY ~w: ~w~n", [GID, Any]), + Any + end; + +read(<>) -> + {?PP_PLAYER_INFO_REQ, PID}; + +read(<>) -> + {?PP_SEAT_STATE, GID, SeatNum, State, PID}; + +%%% Server -> Client + +read(<>) -> + case LimitType of + ?LT_FIXED_LIMIT -> + <> = Bin, + Limit = {?LT_FIXED_LIMIT, Low / 100, High / 100} + end, + {?PP_GAME_INFO, GID, GameType, Expected, Joined, Waiting, Limit}; + +read(<>) -> + {Nick, Bin1} = read_string(Bin), + {Location, _} = read_string(Bin1), + {?PP_PLAYER_INFO, PID, InPlay / 100, Nick, Location}; + +read(<>) -> + {?PP_BET_REQ, GID, Call / 100, Min / 100, Max / 100}; + +read(<>) + when Cmd == ?PP_NOTIFY_DRAW; + Cmd == ?PP_NOTIFY_SHARED -> + {Cmd, GID, {hand:face(1 bsl Face), hand:suit(Suit)}, Seq}; + +read(<>) -> + {?PP_NOTIFY_JOIN, GID, PID, SeatNum, Seq}; + +read(<>) + when Cmd == ?PP_NOTIFY_PRIVATE; + Cmd == ?PP_NOTIFY_LEAVE -> + {Cmd, GID, PID, Seq}; + +read(<>) -> + {Message, _} = read_string(Bin), + {?PP_NOTIFY_CHAT, GID, PID, Seq, Message}; + +read(<>) + when Cmd == ?PP_NOTIFY_START_GAME; + Cmd == ?PP_NOTIFY_CANCEL_GAME; + Cmd == ?PP_NOTIFY_END_GAME -> + {Cmd, GID, Seq}; + +read(<>) + when Cmd == ?PP_NOTIFY_WIN; + Cmd == ?PP_NOTIFY_CALL; + Cmd == ?PP_NOTIFY_RAISE; + Cmd == ?PP_NOTIFY_BET -> + {Cmd, GID, PID, Amount / 100, Seq}; + +%% Player state change + +read(<>) -> + {?PP_PLAYER_STATE, GID, PID, State, Seq}; + +%% Game stage + +read(<>) -> + {?PP_GAME_STAGE, GID, Stage, Seq}; + +read(<>) -> + case LimitType of + ?LT_FIXED_LIMIT -> + <> = Bin, + Limit = {?LT_FIXED_LIMIT, Low / 100, High / 100} + end, + {?PP_NEW_GAME_REQ, GameType, Expected, Limit}; + +read(<>) -> + {?PP_BALANCE_INFO, Balance / 100, Inplay / 100}; + +read(<>) + when Cmd == ?PP_NOTIFY_BUTTON; + Cmd == ?PP_NOTIFY_SB; + Cmd == ?PP_NOTIFY_BB -> + {Cmd, GID, SeatNum, Seq}; + +read(<>) -> + {?PP_MAKE_TEST_GAME, Bin}; + +%% Catch-all + +read(Bin) when is_binary(Bin) -> + none. + +%%% Client -> Server + +write(Cmd) + when Cmd == ?PP_LOGOUT; + Cmd == ?PP_PING; + Cmd == ?PP_PONG; + Cmd == ?PP_BALANCE_REQ -> + <>; + +write({?PP_GOOD, Cmd, Extra}) -> + <>; + +write({?PP_BAD, Cmd, Error}) -> + <>; + +write({?PP_HANDOFF, Port, Host}) + when is_number(Port), + is_list(Host) -> + L = [?PP_HANDOFF, <>, length(Host)|Host], + list_to_binary(L); + +write({?PP_LOGIN, Nick, Pass}) + when is_list(Nick), + is_list(Pass) -> + L1 = [length(Pass)|Pass], + L2 = [?PP_LOGIN, length(Nick), Nick|L1], + list_to_binary(L2); + +write({?PP_PID, PID}) + when is_number(PID) -> + <>; + +write({?PP_JOIN, GID, SeatNum, BuyIn}) + when is_number(GID), + is_number(SeatNum) -> + <>; + +write({Cmd, GID}) + when Cmd == ?PP_WATCH, is_number(GID); + Cmd == ?PP_UNWATCH, is_number(GID); + Cmd == ?PP_SIT_OUT, is_number(GID); + Cmd == ?PP_COME_BACK, is_number(GID); + Cmd == ?PP_JOIN, is_number(GID); + Cmd == ?PP_FOLD, is_number(GID); + Cmd == ?PP_LEAVE, is_number(GID) -> + <>; + +write({Cmd, GID, Amount}) + when Cmd == ?PP_CALL, is_number(GID); + Cmd == ?PP_RAISE, is_number(GID) -> + <>; + +write({?PP_CHAT, GID, Msg}) + when is_number(GID), + is_list(Msg) -> + list_to_binary([?PP_CHAT, <>, length(Msg)|Msg]); + +write({?PP_GAME_QUERY, + GameType, LimitType, + ExpOp, Expected, + JoinOp, Joined, + WaitOp, Waiting}) -> + <>; + +write({?PP_SEAT_QUERY, GID}) -> + <>; + +write({?PP_PLAYER_INFO_REQ, PID}) -> + <>; + +write({?PP_SEAT_STATE, GID, SeatNum, State, PID}) + when State == ?SS_EMPTY; + State == ?SS_RESERVED; + State == ?SS_TAKEN -> + <>; + +write({?PP_NEW_GAME_REQ, GameType, Expected, LimitType}) -> + case LimitType of + {?LT_FIXED_LIMIT, Low, High} -> + <>; + _ -> + none + end; + +%%% Server -> Client + +write({?PP_GAME_INFO, GID, GameType, + Expected, Joined, Waiting, + {?LT_FIXED_LIMIT, Low, High}}) + when is_number(GID), + is_number(GameType), + is_number(Expected), + is_number(Joined), + is_number(Waiting), + is_number(Low), + is_number(High) -> + <>; + +write({?PP_PLAYER_INFO, Player, InPlay, Nick, Location}) + when is_pid(Player), + is_number(InPlay), + is_list(Nick), + is_list(Location) -> + PID = gen_server:call(Player, 'ID'), + L1 = [length(Location)|Location], + L2 = [?PP_PLAYER_INFO, <>, + <<(trunc(InPlay * 100)):32>>, + length(Nick), Nick|L1], + list_to_binary(L2); + +write({?PP_BET_REQ, Game, Call, Min, Max}) + when is_pid(Game), + is_number(Call), + is_number(Min), + is_number(Max) -> + GID = cardgame:call(Game, 'ID'), + <>; + +write({Cmd, GID, {Face, Suit}, Seq}) + when Cmd == ?PP_NOTIFY_DRAW, + is_number(GID), + is_atom(Face), + is_atom(Suit), + is_number(Seq); + Cmd == ?PP_NOTIFY_SHARED, + is_number(GID), + is_atom(Face), + is_atom(Suit), + is_number(Seq) -> + <>; + +write({?PP_NOTIFY_JOIN, GID, Player, SeatNum, Seq}) +when is_number(GID), + is_pid(Player), + is_number(SeatNum), + is_number(Seq) -> + PID = gen_server:call(Player, 'ID'), + <>; + +write({Cmd, GID, Player, Seq}) + when Cmd == ?PP_NOTIFY_PRIVATE, + is_number(GID), + is_pid(Player), + is_number(Seq); + Cmd == ?PP_NOTIFY_LEAVE, + is_number(GID), + is_pid(Player), + is_number(Seq) -> + PID = gen_server:call(Player, 'ID'), + <>; + +write({?PP_NOTIFY_CHAT, GID, Player, Seq, Msg}) + when is_number(GID), + is_pid(Player), + is_number(Seq), + is_list(Msg) -> + PID = gen_server:call(Player, 'ID'), + L1 = [length(Msg)|Msg], + L2 = [?PP_NOTIFY_CHAT, <>, <>, <>|L1], + list_to_binary(L2); + +write({?PP_NOTIFY_CHAT, GID, 0, Seq, Msg}) + when is_number(GID), + is_number(Seq), + is_list(Msg) -> + PID = 0, + L1 = [length(Msg)|Msg], + L2 = [?PP_NOTIFY_CHAT, <>, <>, <>|L1], + list_to_binary(L2); + +write({Cmd, GID, Seq}) + when Cmd == ?PP_NOTIFY_START_GAME, + is_number(GID), + is_number(Seq); + Cmd == ?PP_NOTIFY_CANCEL_GAME, + is_number(GID), + is_number(Seq); + Cmd == ?PP_NOTIFY_END_GAME, + is_number(GID), + is_number(Seq) -> + <>; + +write({Cmd, GID, Player, Amount, Seq}) + when Cmd == ?PP_NOTIFY_WIN, + is_number(GID), + is_pid(Player), + is_number(Amount), + is_number(Seq); + Cmd == ?PP_NOTIFY_CALL, + is_number(GID), + is_pid(Player), + is_number(Amount), + is_number(Seq); + Cmd == ?PP_NOTIFY_RAISE, + is_number(GID), + is_pid(Player), + is_number(Amount), + is_number(Seq); + Cmd == ?PP_NOTIFY_BET, + is_number(GID), + is_pid(Player), + is_number(Amount), + is_number(Seq) -> + PID = gen_server:call(Player, 'ID'), + <>; + +%% Player state change + +write({?PP_PLAYER_STATE, GID, Player, State, Seq}) + when is_number(State), + is_number(GID), + is_pid(Player), + is_number(Seq) -> + PID = gen_server:call(Player, 'ID'), + <>; + +%% Game stage + +write({?PP_GAME_STAGE, GID, Stage, Seq}) + when is_number(GID), + is_number(Stage), + is_number(Seq) -> + <>; + +%% Player balance + +write({?PP_BALANCE_INFO, Balance, Inplay}) -> + <>; + +write({Cmd, GID, SeatNum, Seq}) + when Cmd == ?PP_NOTIFY_BUTTON; + Cmd == ?PP_NOTIFY_SB; + Cmd == ?PP_NOTIFY_BB -> + <>; + +write(Tuple) + when is_tuple(Tuple) -> + none. + +read_string(Bin) -> + <> = Bin, + <> = Bin1, + {binary_to_list(Str), Rest}. + +find_game(GID) -> + case db:find(game_xref, GID) of + {atomic, [XRef]} -> + XRef#game_xref.pid; + Any -> + io:format("find_game(~w): ~w~n", [GID, Any]), + none + end. + +%%% +%%% Test suite +%%% + +test() -> + ok. diff --git a/openpoker-server/src/proto.hrl b/openpoker-server/src/proto.hrl new file mode 100644 index 0000000..f974183 --- /dev/null +++ b/openpoker-server/src/proto.hrl @@ -0,0 +1,158 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-define(PP_BAD, 250). +-define(PP_GOOD, 0). +-define(PP_PID_NONE, 0). + +%%% Client -> Server + +-define(PP_LOGIN, 1). +-define(PP_LOGOUT, 2). +-define(PP_WATCH, 3). +-define(PP_UNWATCH, 4). +%%-define(PP_BLIND, 5). +-define(PP_CALL, 6). +-define(PP_RAISE, 7). +-define(PP_FOLD, 8). +-define(PP_JOIN, 9). +-define(PP_LEAVE, 10). +-define(PP_SIT_OUT, 11). +-define(PP_COME_BACK, 12). +-define(PP_CHAT, 13). + +%%% Server -> Client + +-define(PP_GAME_INFO, 14). +-define(PP_PLAYER_INFO, 15). +%%-define(PP_BLIND_REQ, 16). +-define(PP_BET_REQ, 17). +-define(PP_NOTIFY_DRAW, 18). +-define(PP_NOTIFY_PRIVATE, 19). +-define(PP_NOTIFY_SHARED, 20). +-define(PP_NOTIFY_JOIN, 21). +-define(PP_NOTIFY_LEAVE, 22). +-define(PP_NOTIFY_CHAT, 23). +-define(PP_NOTIFY_START_GAME, 24). +-define(PP_NOTIFY_END_GAME, 25). +-define(PP_NOTIFY_WIN, 26). +-define(PP_NOTIFY_BET, 27). +%% 28 - unused +-define(PP_NOTIFY_RAISE, 29). +-define(PP_NOTIFY_CALL, 30). +-define(PP_PLAYER_STATE, 31). +-define(PP_GAME_STAGE, 32). +-define(PP_SEAT_STATE, 33). +-define(PP_NOTIFY_BUTTON, 34). +-define(PP_PID, 35). +-define(PP_HANDOFF, 36). +-define(PP_GAME_QUERY, 37). +-define(PP_NOTIFY_CANCEL_GAME, 38). +-define(PP_SEAT_QUERY, 39). +-define(PP_PLAYER_INFO_REQ, 40). +-define(PP_NEW_GAME_REQ, 41). +-define(PP_BALANCE_REQ, 42). +-define(PP_BALANCE_INFO, 43). +-define(PP_NOTIFY_SB, 44). +-define(PP_NOTIFY_BB, 45). + +-define(PP_MAKE_TEST_GAME, 252). +-define(PP_PONG, 253). +-define(PP_PING, 254). + +%%% Game stage + +-define(GS_PREFLOP, 1). +-define(GS_FLOP, 2). +-define(GS_TURN, 3). +-define(GS_RIVER, 4). +-define(GS_DELAYED_START, 5). +-define(GS_BLINDS, 6). +-define(GS_SHOWDOWN, 7). + +%%% Game type + +-define(GT_TEXAS_HOLDEM, 1). +-define(GT_IRC_TEXAS, 2). % IRC poker db + +%%% Limit type + +-define(LT_FIXED_LIMIT, 1). + +%%% Seat state + +-define(SS_EMPTY, 0). +-define(SS_RESERVED, 1). +-define(SS_TAKEN, 2). + +%%% Logical op + +-define(OP_IGNORE, 0). +-define(OP_EQUAL, 1). +-define(OP_LESS, 2). +-define(OP_GREATER, 3). + +%%% Player state + +-define(PS_EMPTY, 0). +-define(PS_PLAY, 1). +-define(PS_FOLD, 2). +-define(PS_WAIT_BB, 4). +-define(PS_SIT_OUT, 8). +-define(PS_MAKEUP_BB, 16). +-define(PS_ALL_IN, 32). +-define(PS_BET, 64). +-define(PS_RESERVED, 128). + +-define(PS_ANY, + ?PS_PLAY bor + ?PS_FOLD bor + ?PS_WAIT_BB bor + ?PS_SIT_OUT bor + ?PS_MAKEUP_BB bor + ?PS_ALL_IN bor + ?PS_BET). + +-define(PS_ACTIVE, + ?PS_PLAY bor + ?PS_MAKEUP_BB). + +-define(PS_BB_ACTIVE, + ?PS_PLAY bor + ?PS_WAIT_BB bor + ?PS_MAKEUP_BB). + +-define(PS_SHOWDOWN, + ?PS_PLAY bor + ?PS_BET bor + ?PS_ALL_IN). + +-define(PS_STANDING, + ?PS_PLAY bor + ?PS_ALL_IN bor + ?PS_BET). + +%%% Error codes + +-define(ERR_UNKNOWN, 0). +-define(ERR_BAD_LOGIN, 1). +-define(ERR_ACCOUNT_DISABLED, 2). +-define(ERR_START_DISABLED, 3). diff --git a/openpoker-server/src/schema.erl b/openpoker-server/src/schema.erl new file mode 100644 index 0000000..fb06533 --- /dev/null +++ b/openpoker-server/src/schema.erl @@ -0,0 +1,145 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(schema). + +-export([install/1, populate/0]). + +-include("schema.hrl"). +-include("common.hrl"). +-include("proto.hrl"). + +install(Nodes) when is_list(Nodes) -> + mnesia:stop(), + mnesia:delete_schema(Nodes), + catch(mnesia:create_schema(Nodes)), + mnesia:start(), + %% counter + case mnesia:create_table(counter, + [ + {disc_copies, Nodes}, + {type, set}, + {attributes, record_info(fields, counter)} + ]) of + {atomic, ok} -> + ok; + Any -> + error_logger:error_report([{message, "Cannot install table"}, + {table, counter}, + {error, Any}, + {nodes, Nodes}]) + end, + %% player + case mnesia:create_table(player, + [ + {disc_copies, Nodes}, + {index, [nick]}, + {type, set}, + {attributes, record_info(fields, player)} + ]) of + {atomic, ok} -> + ok; + Any1 -> + error_logger:error_report([{message, "Cannot install table"}, + {table, player}, + {error, Any1}, + {nodes, Nodes}]) + end, + %% online game + case mnesia:create_table(game_xref, + [ + {disc_copies, Nodes}, + {type, set}, + {attributes, record_info(fields, game_xref)} + ]) of + {atomic, ok} -> + ok; + Any3 -> + error_logger:error_report([{message, "Cannot install table"}, + {table, game_xref}, + {error, Any3}, + {nodes, Nodes}]) + end, + %% game history + case mnesia:create_table(game_history, + [ + {disc_copies, Nodes}, + {type, set}, + {attributes, record_info(fields, game_history)} + ]) of + {atomic, ok} -> + ok; + Any4 -> + error_logger:error_report([{message, "Cannot install table"}, + {table, game_history}, + {error, Any4}, + {nodes, Nodes}]) + end, + %% cluster configuration + case mnesia:create_table(cluster_config, + [ + {disc_copies, Nodes}, + {type, set}, + {attributes, record_info(fields, cluster_config)} + ]) of + {atomic, ok} -> + ok; + Any5 -> + error_logger:error_report([{message, "Cannot install table"}, + {table, cluster_config}, + {error, Any5}, + {nodes, Nodes}]) + end, + Conf = #cluster_config { + id = 0, + mnesia_masters = Nodes + }, + F = fun() -> + mnesia:write(Conf) + end, + {atomic, ok} = mnesia:transaction(F), + case mnesia:create_table(game_config, + [ + {disc_copies, Nodes}, + {type, set}, + {attributes, record_info(fields, game_config)} + ]) of + {atomic, ok} -> + ok; + Any6 -> + error_logger:error_report([{message, "Cannot install table"}, + {table, game_config}, + {error, Any6}, + {nodes, Nodes}]) + end, + populate(), + ok. + +populate() -> + game:setup(?GT_IRC_TEXAS, 20, + {?LT_FIXED_LIMIT, 10, 20}, + ?START_DELAY, ?PLAYER_TIMEOUT, + 10), + game:setup(?GT_TEXAS_HOLDEM, 10, + {?LT_FIXED_LIMIT, 10, 20}, + ?START_DELAY, ?PLAYER_TIMEOUT, + 100). + diff --git a/openpoker-server/src/schema.hrl b/openpoker-server/src/schema.hrl new file mode 100644 index 0000000..3e04d6c --- /dev/null +++ b/openpoker-server/src/schema.hrl @@ -0,0 +1,85 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-record(counter, { + type, + value + }). + +-record(player, { + oid, % object id + nick, + password, + location, + balance = 0.0, + inplay = 0.0, % only used while in a game + login_errors = 0, + pid = none, % process id + socket = none, % socket process + game = none, % current game + disabled = false % player is disabled + }). + +-record(game_xref, { + oid, + pid, + type, + limit + }). + +-record(seat_history, { + nick, + hand, + state + }). + +-record(game_history, { + key, + type, + seats, + limit, + board, + pot, + events + }). + +%% app config + +-record(game_config, { + id, + type, + seat_count, + limit, + start_delay, + player_timeout, + max + }). + +-record(cluster_config, { + id, + gateways = [], + mnesia_masters = [], + logdir = "/tmp", + max_login_errors = 5, + %% players can start games + enable_dynamic_games = false + }). + diff --git a/openpoker-server/src/server.erl b/openpoker-server/src/server.erl new file mode 100644 index 0000000..d4ba7b2 --- /dev/null +++ b/openpoker-server/src/server.erl @@ -0,0 +1,329 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(server). +-behaviour(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). + +-export([start/1, start/2, start/3, stop/1, test/0]). + +-include("common.hrl"). +-include("proto.hrl"). +-include("texas.hrl"). +-include("schema.hrl"). +-include("test.hrl"). + +-record(server, { + port, + host, + avg, + games, + test_mode + }). + +-record(client, { + server = none, + player = none + }). + +start([Port, Host]) + when is_atom(Port), + is_atom(Host) -> + Port1 = list_to_integer(atom_to_list(Port)), + Host1 = atom_to_list(Host), + start(Host1, Port1). + +start(Host, Port) -> + start(Host, Port, false). + +start(Host, Port, TestMode) -> + mnesia:start(), + case mnesia:wait_for_tables([game_config, game_xref], 10000) of + ok -> + case gen_server:start(server, [Host, Port, TestMode], []) of + {ok, Pid} -> + %%io:format("server:start: pid ~w~n", [Pid]), + pg2:create(?GAME_SERVERS), + ok = pg2:join(?GAME_SERVERS, Pid), + {ok, Pid}; + Result -> + error_logger:error_report( + [{module, ?MODULE}, + {line, ?LINE}, + {message, "Unexpected result"}, + {call, 'gen_server:start(server)'}, + {result, Result}, + {port, Port}, + {now, now()}]), + Result + end; + Other -> + error_logger:error_report( + [{module, ?MODULE}, + {line, ?LINE}, + {message, "Unexpected result"}, + {result, Other}, + {call, 'mnesia:wait_for_tables'}, + {now, now()}]), + Other + end. + +init([Host, Port, TestMode]) -> + process_flag(trap_exit, true), + %%error_logger:logfile({open, "/tmp/" + %% ++ atom_to_list(node()) + %% ++ ".log"}), + Client = #client { + server = self() + }, + F = fun(Sock) -> parse_packet(Sock, Client) end, + tcp_server:stop(Port), + {ok, _} = tcp_server:start_raw_server(Port, F, 10240, 2048), + Server = #server { + host = Host, + port = Port, + avg = 0, + games = start_games(), + test_mode = TestMode + }, + {ok, Server}. + +stop(Server) -> + gen_server:cast(Server, stop). + +terminate(normal, Server) -> + kill_games(Server#server.games), + tcp_server:stop(Server#server.port), + ok. + +handle_cast(stop, Server) -> + {stop, normal, Server}; + +handle_cast(Event, Server) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Event}]), + {noreply, Server}. + + +handle_call('WHERE', _From, Server) -> + {reply, {Server#server.host, Server#server.port}, Server}; +%% {ok, [{X, _, _}|_]} = inet:getif(), +%% io:format("Server address: ~w~n", [X]), +%% Host = io_lib:format("~.B.~.B.~.B.~.B", +%% [element(1, X), +%% element(2, X), +%% element(3, X), +%% element(4, X)]), +%% {reply, {Host, Server#server.port}, Server}; + +handle_call('USER COUNT', _From, Server) -> + Children = tcp_server:children(Server#server.port), + {reply, length(Children), Server}; + +handle_call('TEST MODE', _From, Server) -> + {reply, Server#server.test_mode, Server}; + +handle_call(Event, From, Server) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Event}, + {from, From}]), + {noreply, Server}. + +handle_info({'EXIT', _Pid, _Reason}, Server) -> + %% child exit? + {noreply, Server}; + +handle_info(Info, Server) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Info}]), + {noreply, Server}. + +code_change(_OldVsn, Server, _Extra) -> + {ok, Server}. + +parse_packet(Socket, Client) -> + receive + {tcp, Socket, Bin} -> + %%io:format("--> ~w~n", [Bin]), + case proto:read(Bin) of + {?PP_LOGIN, Nick, Pass} -> + %%io:format("Logging in ~s~n", [Nick]), + case login:login(Nick, Pass, self()) of + {error, Error} -> + %%io:format("Login error: ~w~n", [Error]), + ok = ?tcpsend(Socket, {?PP_BAD, + ?PP_LOGIN, + Error}), + parse_packet(Socket, Client); + {ok, Player} -> + %% disconnect visitor + if + Client#client.player /= none -> + gen_server:cast(Client#client.player, + 'DISCONNECT'); + true -> + ok + end, + ID = gen_server:call(Player, 'ID'), + ok = ?tcpsend(Socket, {?PP_PID, ID}), + Client1 = Client#client { + player = Player + }, + parse_packet(Socket, Client1) + end; + ?PP_LOGOUT -> + gen_server:cast(Client#client.player, 'LOGOUT'), + ok = ?tcpsend(Socket, {?PP_GOOD, + ?PP_LOGOUT, + 0}), + %% Replace player process with a visitor + {ok, Visitor} = visitor:start(), + Client1 = Client#client { + player = Visitor + }, + gen_server:cast(Visitor, {'SOCKET', self()}), + parse_packet(Socket, Client1); + {?PP_GAME_QUERY, + GameType, LimitType, + ExpOp, Expected, + JoinOp, Joined, + WaitOp, Waiting} -> + _ST = now(), + find_games(Socket, + GameType, LimitType, + ExpOp, Expected, + JoinOp, Joined, + WaitOp, Waiting), + _ET = now(), + %%Elapsed = timer:now_diff(ET, ST) / 1000, + %%io:format("~wms to send games to ~w~n", + %% [Elapsed, Socket]), + parse_packet(Socket, Client); + {?PP_MAKE_TEST_GAME, Data} -> + case gen_server:call(Client#client.server, + 'TEST MODE') of + true -> + ok = ?tcpsend(Socket, start_test_game(Data)); + _ -> + ok + end, + parse_packet(Socket, Client); + ?PP_PING -> + ok = ?tcpsend(Socket, ?PP_PONG), + parse_packet(Socket, Client); + none -> + io:format("Unrecognized packet: ~w~n", [Bin]); + Event -> + Client1 = if + Client#client.player == none -> + %% start a proxy + {ok, Visitor} = visitor:start(), + gen_server:cast(Visitor, + {'SOCKET', self()}), + Client#client { + player = Visitor + }; + true -> + Client + end, + gen_server:cast(Client1#client.player, Event), + parse_packet(Socket, Client1) + end; + {tcp_closed, Socket} -> + gen_server:cast(Client#client.player, 'DISCONNECT'); + {packet, Packet} -> + %%io:format("<-- ~w~n", [Packet]), + ok = ?tcpsend(Socket, Packet), + parse_packet(Socket, Client) + end. + +find_games(Socket, + GameType, LimitType, + ExpOp, Expected, + JoinOp, Joined, + WaitOp, Waiting) -> + {atomic, L} = game:find(GameType, LimitType, + ExpOhowdown(Event, Data) -> + handle_event(Event, showdown, Data). +p, Expected, + JoinOp, Joined, + WaitOp, Waiting), + lists:foreach(fun(Packet) -> + ?tcpsend(Socket, Packet) + end, L). + +start_games() -> + {atomic, Games} = db:find(game_config), + start_games(Games, []). + +start_games([Game|Rest], Acc) -> + Acc1 = start_games(Game, Game#game_config.max, Acc), + start_games(Rest, Acc1); + +start_games([], Acc) -> + Acc. + +start_games(_Game, 0, Acc) -> + Acc; + +start_games(Game, N, Acc) -> + {ok, Pid} = cardgame:start(Game#game_config.type, + Game#game_config.seat_count, + Game#game_config.limit, + Game#game_config.start_delay, + Game#game_config.player_timeout), + start_games(Game, N - 1, [Pid|Acc]). + +kill_games([]) -> + ok; + +kill_games([Pid|Rest]) -> + cardgame:stop(Pid), + kill_games(Rest). + +start_test_game(Bin) + when is_binary(Bin) -> + {GameType, Expected, Limit, Delay, Timeout, Cards} = + binary_to_term(Bin), + {ok, Pid} = cardgame:start(GameType, + Expected, + Limit, + Delay, + Timeout), + cardgame:cast(Pid, {'RIG', Cards}), + cardgame:cast(Pid, {'REQUIRED', Expected}), + GID = cardgame:call(Pid, 'ID'), + {?PP_GOOD, ?PP_MAKE_TEST_GAME, GID}. + +%% +%% Test suite +%% + +test() -> + ok. diff --git a/openpoker-server/src/showdown.erl b/openpoker-server/src/showdown.erl new file mode 100644 index 0000000..af38a33 --- /dev/null +++ b/openpoker-server/src/showdown.erl @@ -0,0 +1,186 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(showdown). +-behaviour(cardgame). + +-export([stop/1, test/0]). + +-export([init/1, terminate/3]). +-export([handle_event/3, handle_info/3, + handle_sync_event/4, code_change/4]). + +-export([showdown/2, dump_pot/2]). + +-include("common.hrl"). +-include("test.hrl"). +-include("proto.hrl"). + +-record(data, { + game + }). + +init([Game]) -> + Data = #data { + game = Game + }, + {ok, showdown, Data}. + +stop(Ref) -> + cardgame:send_all_state_event(Ref, stop). + +showdown({'START', Context}, Data) -> + Game = Data#data.game, + Seats = gen_server:call(Game, {'SEATS', ?PS_SHOWDOWN}), + N = length(Seats), + if + N == 1 -> + %% last man standing wins + Total = gen_server:call(Game, 'POT TOTAL'), + Player = gen_server:call(Game, {'PLAYER AT', hd(Seats)}), + gen_server:cast(Player, {'INPLAY+', Total}), + Event = {?PP_NOTIFY_WIN, Player, Total}, + gen_server:cast(Game, {'BROADCAST', Event}), + Winners = [{{Player, none, none, none}, Total}]; + true -> + Ranks = gen_server:call(Game, 'RANK HANDS'), + Pots = gen_server:call(Game, 'POTS'), + Winners = gb_trees:to_list(winners(Ranks, Pots)), + lists:foreach(fun({{Player, _, _, _}, Amount}) -> + gen_server:cast(Player, {'INPLAY+', Amount}), + Event = {?PP_NOTIFY_WIN, Player, Amount}, + gen_server:cast(Game, {'BROADCAST', Event}) + end, Winners) + end, + gen_server:cast(Game, {'BROADCAST', {?PP_NOTIFY_END_GAME}}), + _Ctx = setelement(4, Context, Winners), + {stop, {normal, restart, Context}, Data}; + +showdown(Event, Data) -> + handle_event(Event, showdown, Data). + +handle_event(stop, _State, Data) -> + {stop, normal, Data}; + +handle_event(Event, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {message, Event}, + {self, self()}, + {game, Data#data.game}]), + {next_state, State, Data}. + +handle_sync_event(Event, From, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {message, Event}, + {from, From}, + {self, self()}, + {game, Data#data.game}]), + {next_state, State, Data}. + +handle_info(Info, State, Data) -> + error_logger:error_report([{module, ?MODULE}, + {line, ?LINE}, + {message, Info}, + {self, self()}, + {game, Data#data.game}]), + {next_state, State, Data}. + +terminate(_Reason, _State, _Data) -> + ok. + +code_change(_OldVsn, State, Data, _Extra) -> + {ok, State, Data}. + +%% +%% Utility +%% + +winners(Ranks, Pots) -> + winners(Ranks, Pots, gb_trees:empty()). + +winners(_Ranks, [], Winners) -> + Winners; + +winners(Ranks, [{Total, Members}|Rest], Winners) -> + F = fun({Player, _Value, _High, _Score}) -> + gb_trees:is_defined(Player, Members) + end, + M = lists:filter(F, Ranks), + %%dump_pot(Total, M), + %% sort by rank + M1 = lists:reverse(lists:keysort(2, M)), + %% leave top ranks only + TopRank = element(2, hd(M1)), + M2 = lists:filter(fun(R) -> + element(2, R) == TopRank + end, M1), + %% sort by high card + M3 = lists:reverse(lists:keysort(3, M2)), + %% leave top high cards only + TopHigh = element(3, hd(M3)), + M4 = lists:filter(fun(R) -> + element(3, R) == TopHigh + end, M3), + %% sort by top score + M5 = lists:reverse(lists:keysort(4, M4)), + %% leave top scores only + TopScore = element(4, hd(M5)), + M6 = lists:filter(fun(R) -> + element(4, R) == TopScore + end, M5), + Win = Total / length(M6), + Winners1 = update_winners(M6, Win, Winners), + winners(Ranks, Rest, Winners1). + +update_winners([], _Amount, Tree) -> + Tree; + +update_winners([Player|Rest], Amount, Tree) -> + update_winners(Rest, Amount, + update_counter(Player, Amount, Tree)). + +update_counter(Key, Amount, Tree) -> + case gb_trees:lookup(Key, Tree) of + {value, Old} -> + Old = gb_trees:get(Key, Tree), + gb_trees:update(Key, Old + Amount, Tree); + none -> + gb_trees:insert(Key, Amount, Tree) + end. + +dump_pot(Total, Members) -> + io:format("Pot Total=~w~n", [Total]), + F = fun({Player, Rank, High, Score}) -> + Nick = gen_server:call(Player, 'NICK'), + Desc = hand:describe({Rank, High, Score}), + io:format("~s has a ~s~n", [Nick, Desc]) + end, + lists:foreach(F, Members). + +%% +%% Test suite +%% + +test() -> + ok. + diff --git a/openpoker-server/src/tcp_server.erl b/openpoker-server/src/tcp_server.erl new file mode 100644 index 0000000..73854bb --- /dev/null +++ b/openpoker-server/src/tcp_server.erl @@ -0,0 +1,180 @@ +%% Copyright (C) 2002, Joe Armstrong +%% File : tcp_server.erl +%% Author : Joe Armstrong (joe@sics.se) +%% Purpose : Keeps track of a number of TCP sessions +%% Last modified: 2002-11-17 + +-module(tcp_server). + +-export([start_raw_server/4, start_client/3, stop/1, children/1]). + +-define(KILL_DELAY, 1000). + +%% -export([start_child/3]). + +%% start_raw_server(Port, Fun, Max) +%% This server accepts up to Max connections on Port +%% The *first* time a connection is made to Port +%% Then Fun(Socket) is called. +%% Thereafter messages to the socket result in messsages to the handler. + +%% a typical server is usually written like this: + +%% To setup a lister + +%% start_server(Port) -> +%% S = self(), +%% process_flag(trap_exit, true), +%% tcp_server:start_raw_server(Port, +%% fun(Socket) -> input_handler(Socket, S) end, +%% 15, +%% 0) +%% loop(). + +%% The loop() process is a central controller that all +%% processes can use to synchronize amongst themselfves if necessary +%% It ends up as the variable "Controller" in the input_handler + +%% A typical server is written like this: + +%% input_handler(Socket, Controller) -> +%% receive +%% {tcp, Socket, Bin} -> +%% ... +%% gen_tcp:send(Socket, ...) +%% +%% {tcp_closed, Socket} -> +%% +%% +%% Any -> +%% ... +%% +%% end. + +start_client(Host, Port, Length) -> + gen_tcp:connect(Host, Port, + [binary, + {active, true}, + {packet, 2}, + {packet_size, Length}], 30000). + +%% Note when start_raw_server returns it should be ready to +%% Immediately accept connections + +start_raw_server(Port, Fun, Max, Length) -> + Name = port_name(Port), + case whereis(Name) of + undefined -> + Self = self(), + Pid = spawn_link(fun() -> + cold_start(Self, Port, Fun, Max, Length) + end), + receive + {Pid, ok} -> + register(Name, Pid), + {ok, Pid}; + {Pid, Error} -> + Error + end; + _Pid -> + {error, already_started} + end. + +stop(Port) when integer(Port) -> + Name = port_name(Port), + case whereis(Name) of + undefined -> + not_started; + Pid -> + exit(Pid, kill), + (catch unregister(Name)), + stopped + end. + +children(Port) when integer(Port) -> + port_name(Port) ! {children, self()}, + receive + {session_server, Reply} -> Reply + end. + +port_name(Port) when integer(Port) -> + list_to_atom("portServer" ++ integer_to_list(Port)). + +cold_start(Master, Port, Fun, Max, Length) -> + process_flag(trap_exit, true), + io:format("Starting a port server on ~p...~n",[Port]), + case gen_tcp:listen(Port, [binary, + %% {dontroute, true}, + {nodelay,true}, + {packet_size, Length}, + {packet, 2}, + {backlog, 1024}, + {reuseaddr, true}, + {active, false}]) of + {ok, Listen} -> + %% io:format("Listening on:~p~n",[Listen]), + Master ! {self(), ok}, + New = start_accept(Listen, Fun), + %% Now we're ready to run + socket_loop(Listen, New, [], Fun, Max); + Error -> + Master ! {self(), Error} + end. + +%% Don't mess with the following code uless you really know what you're +%% doing (and Thanks to Magnus for heping me get it right) + +socket_loop(Listen, New, Active, Fun, Max) -> + receive + {istarted, New} -> + Active1 = [New|Active], + possibly_start_another(false, Listen, Active1, Fun, Max); + {'EXIT', New, _Why} -> + %%io:format("Child exit=~p~n",[Why]), + possibly_start_another(false, Listen, Active, Fun, Max); + {'EXIT', Pid, _Why} -> + %%io:format("Child exit=~p~n",[Why]), + Active1 = lists:delete(Pid, Active), + possibly_start_another(New, Listen, Active1, Fun, Max); + {children, From} -> + From ! {session_server, Active}, + socket_loop(Listen, New, Active, Fun, Max); + Other -> + io:format("Here in loop:~p~n",[Other]) + end. + +possibly_start_another(New, Listen, Active, Fun, Max) when pid(New) -> + socket_loop(Listen, New, Active, Fun, Max); +possibly_start_another(false, Listen, Active, Fun, Max) -> + case length(Active) of + N when N < Max -> + New = start_accept(Listen, Fun), + socket_loop(Listen, New, Active, Fun, Max); + _ -> + error_logger:warning_report( + [{module, ?MODULE}, + {line, ?LINE}, + {message, "Connections maxed out"}, + {maximum, Max}, + {connected, length(Active)}, + {now, now()}]), + socket_loop(Listen, false, Active, Fun, Max) + end. + +start_accept(Listen, Fun) -> + S = self(), + spawn_link(fun() -> start_child(S, Listen, Fun) end). + +start_child(Parent, Listen, Fun) -> + case gen_tcp:accept(Listen) of + {ok, Socket} -> + Parent ! {istarted,self()}, % tell the controller + inet:setopts(Socket, [{nodelay,true}, + {packet, 2}, + {active, true}]), % before we activate socket + Fun(Socket); + _Other -> + exit(oops) + end. + + diff --git a/openpoker-server/src/test.erl b/openpoker-server/src/test.erl new file mode 100644 index 0000000..255b007 --- /dev/null +++ b/openpoker-server/src/test.erl @@ -0,0 +1,747 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(test). + +-compile([export_all]). + +-export([all/0, make_players/1, make_test_game/3, + make_player/1, install_trigger/3, kill_players/1]). + +-include("proto.hrl"). +-include("texas.hrl"). +-include("common.hrl"). +-include("schema.hrl"). +-include("test.hrl"). + +-record(test, { + button_seat = none, + call = 0, + winners = none + }). + +all() -> + mnesia:start(), + ok = mnesia:wait_for_tables([game_config], 10000), + %% make sure the basics work + db:test(), + proto:test(), + hand:test(), + pot:test(), + player:test(), + game:test(), + cardgame:test(), + deal_cards:test(), + deck:test(), + fixed_limit:test(), + delayed_start:test(), + blinds:test(), + betting:test(), + showdown:test(), + login:test(), + %% run tests + test10(), + test20(), + test30(), + test40(), + test50(), + test60(), + test70(), + test80(), + test90(), + test100(), + test110(), + test120(), + test130(), + test135(), + test140(), + test150(), + test160(), + test170(), + test180(), + ok. + +%%% Create player + +test10() -> + db:delete(player), + counter:reset(player), + Nick = "P", + %% player does not exist + ?match({error, {atomic, []}}, player:start("blah")), + {atomic, ID} = player:create(Nick, "foo", "", 100), + ?match(1, ID), + {ok, Pid} = player:start(Nick), + ?match({atomic, Pid}, db:get(player, ID, pid)), + player:stop(Pid), + timer:sleep(100), + ?match({atomic, none}, db:get(player, ID, pid)), + ok. + +%%% Create game + +test20() -> + db:delete(game_xref), + counter:reset(game), + GameType = ?GT_IRC_TEXAS, + LimitType = {?LT_FIXED_LIMIT, 10, 20}, + {ok, Game} = cardgame:start(GameType, + 2, + LimitType), + ?match(1, cardgame:call(Game, 'ID')), + ?match(0, cardgame:call(Game, 'JOINED')), + ?match({atomic, Game}, db:get(game_xref, 1, pid)), + cardgame:stop(Game), + timer:sleep(100), + ?match({atomic, []}, db:find(game_xref, 1)), + ok. + +%%% Basic seat query + +test30() -> + db:delete(game_xref), + db:delete(player), + Players = [{Player, 1}] = make_players(1), + Game = make_game(2, Players), + X = cardgame:call(Game, 'SEAT QUERY'), + ?match([{1, ?SS_TAKEN, Player}, + {2, ?SS_EMPTY, none}], X), + Z = cardgame:call(Game, 'JOINED'), + ?match(1, Z), + cardgame:stop(Game), + kill_players(Players), + ok. + +%%% More complex seat query + +test40() -> + db:delete(game_xref), + db:delete(player), + Players = [{Player, 1}] = make_players(1), + %% make sure we are notified + gen_server:cast(Player, {'SOCKET', self()}), + Game = make_game(Players), + GID = cardgame:call(Game, 'ID'), + PID = gen_server:call(Player, 'ID'), + Packet = receive + Any -> + Any + after 100 -> + none + end, + ?match({packet, {?PP_NOTIFY_JOIN, GID, Player, 1, 0}}, Packet), + player:cast(PID, {?PP_SEAT_QUERY, Game}), + Packet1 = receive + Any1 -> + Any1 + after 100 -> + none + end, + ?match({packet, {?PP_SEAT_STATE, GID, 1, ?SS_TAKEN, PID}}, Packet1), + ?differ(none, proto:write({?PP_SEAT_STATE, GID, 1, ?SS_TAKEN, PID})), + cardgame:stop(Game), + kill_players(Players), + ok. + +%%% game:find with lots of parameters + +test50() -> + db:delete(game_xref), + Game1 = make_game(5, []), + cardgame:cast(Game1, {'REQUIRED', 5}), + Game2 = make_game(10, []), + cardgame:cast(Game2, {'REQUIRED', 10}), + Game3 = make_game(15, []), + cardgame:cast(Game3, {'REQUIRED', 15}), + {atomic, L1} = game:find(?GT_IRC_TEXAS, + ?LT_FIXED_LIMIT, + ?OP_IGNORE, 0, + ?OP_IGNORE, 0, + ?OP_IGNORE, 0), + ?match(3, length(L1)), + {atomic, L2} = game:find(?GT_IRC_TEXAS, + ?LT_FIXED_LIMIT, + ?OP_EQUAL, 10, + ?OP_IGNORE, 10, + ?OP_IGNORE, 0), + ?match(1, length(L2)), + {atomic, L3} = game:find(?GT_IRC_TEXAS, + ?LT_FIXED_LIMIT, + ?OP_LESS, 20, + ?OP_IGNORE, 20, + ?OP_IGNORE, 0), + ?match(3, length(L3)), + {atomic, L4} = game:find(?GT_IRC_TEXAS, + ?LT_FIXED_LIMIT, + ?OP_GREATER, 5, + ?OP_IGNORE, 5, + ?OP_IGNORE, 0), + ?match(2, length(L4)), + cardgame:stop(Game1), + cardgame:stop(Game2), + cardgame:stop(Game3), + ok. + +%%% Delayed start + +test60() -> + db:delete(game_xref), + db:delete(player), + Players = make_players(2), + Game = make_test_game(Players, + #test{}, + [{delayed_start, [0]}]), + cardgame:cast(Game, {'TIMEOUT', 0}), + ?match(success, ?waitmsg({'CARDGAME EXIT', Game, #test{}}, 200)), + cardgame:stop(Game), + kill_players(Players), + ok. + +%%% Player not found + +test70() -> + db:delete(player), + counter:reset(player), + ?match({error, ?ERR_BAD_LOGIN}, login:login("#%@#%", "foo", self())), + ok. + +%%% Disable account after X login errors + +test80() -> + db:delete(player), + counter:reset(player), + {atomic, Max} = db:get(cluster_config, 0, max_login_errors), + Nick = pid_to_list(self()), + {atomic, ID} = player:create(Nick, "foo", "", 1000), + test80_1(Nick, Max), + ?match({atomic, Max}, db:get(player, ID, login_errors)), + {atomic, ok} = db:delete(player, ID), + ok. + +test80_1(Nick, 0) -> + ?match({error, ?ERR_ACCOUNT_DISABLED}, + login:login(Nick, "@#%@#%", self())), + ok; + +test80_1(Nick, N) -> + ?match({error, ?ERR_BAD_LOGIN}, login:login(Nick, "@#%@#%", self())), + {atomic, [Player]} = db:find(player, nick, Nick), + Disabled = N == 0, + ?match(Disabled, Player#player.disabled), + test80_1(Nick, N - 1). + +%%% Account disabled + +test90() -> + db:delete(player), + counter:reset(player), + Nick = pid_to_list(self()), + {atomic, ID} = player:create(Nick, "foo", "", 1000), + {atomic, ok} = db:set(player, ID, {disabled, true}), + ?match({error, ?ERR_ACCOUNT_DISABLED}, + login:login(Nick, "@#%@#%", self())), + ?match({error, ?ERR_ACCOUNT_DISABLED}, + login:login(Nick, "foo", self())), + {atomic, ok} = db:delete(player, ID), + ok. + +%%% Log in and log out + +test100() -> + db:delete(player), + counter:reset(player), + Nick = pid_to_list(self()), + Pid = make_player(Nick), + ID = gen_server:call(Pid, 'ID'), + Socket = self(), + ?match({ok, Pid}, login:login(Nick, "foo", Socket)), + ?match({atomic, Pid}, db:get(player, ID, pid)), + ?match({atomic, Socket}, db:get(player, ID, socket)), + ?match(true, util:is_process_alive(Pid)), + login:logout(ID), + ?match(false, util:is_process_alive(Pid)), + ?match({atomic, none}, db:get(player, ID, pid)), + ?match({atomic, none}, db:get(player, ID, socket)), + {atomic, ok} = db:delete(player, ID), + ok. + +%%% Player online but not playing + +test110() -> + db:delete(player), + counter:reset(player), + Nick = pid_to_list(self()), + Pid = make_player(Nick), + ID = gen_server:call(Pid, 'ID'), + Socket = self(), + %% login once + ?match({ok, Pid}, login:login(Nick, "foo", Socket)), + ?match({atomic, Pid}, db:get(player, ID, pid)), + ?match({atomic, Socket}, db:get(player, ID, socket)), + ?match(true, util:is_process_alive(Pid)), + %% login twice + {ok, Pid1} = login:login(Nick, "foo", Pid), + {atomic, Pid1} = db:get(player, ID, pid), + ?match(false, util:is_process_alive(Pid)), + ?differ(Pid, Pid1), + ?match({atomic, Pid}, db:get(player, ID, socket)), + login:logout(ID), + {atomic, ok} = db:delete(player, ID), + receive + Any -> + ?match('should be nothing here', Any) + after 100 -> + ok + end, + ok. + +%%% Player online and playing + +test120() -> + db:delete(player), + counter:reset(player), + Nick = pid_to_list(self()), + Pid = make_player(Nick), + ID = gen_server:call(Pid, 'ID'), + Socket = self(), + %% login once + ?match({ok, Pid}, login:login(Nick, "foo", Socket)), + %% set up a busy player + Game = make_game(2, [{Pid, 1}]), + GID = cardgame:call(Game, 'ID'), + timer:sleep(200), + ?match({atomic, Game}, db:get(player, ID, game)), + %% login twice + ?match({ok, Pid}, login:login(Nick, "foo", Socket)), + ?match({atomic, Game}, db:get(player, ID, game)), + ?match({atomic, Socket}, db:get(player, ID, socket)), + login:logout(ID), + %% look for notify join + ?match(success, ?waitmsg({packet, + {?PP_NOTIFY_JOIN, GID, Pid, 1, 0}}, 100)), + %% look for game update packets. + %% we should have just one. + ?match(success, ?waitmsg({packet, + {?PP_NOTIFY_JOIN, GID, Pid, 1, 0}}, 100)), + {atomic, ok} = db:delete(player, ID), + cardgame:stop(Game), + ok. + +%%% Simulate a disconnected client + +test130() -> + db:delete(player), + counter:reset(player), + Nick = pid_to_list(self()), + Pid = make_player(Nick), + ID = gen_server:call(Pid, 'ID'), + Socket = self(), + Dummy = spawn(fun() -> ok end), + timer:sleep(100), + ?match(false, util:is_process_alive(Dummy)), + ?match({ok, Pid}, login:login(Nick, "foo", Dummy)), + ?match({ok, Pid}, login:login(Nick, "foo", Socket)), + {atomic, Socket} = db:get(player, ID, socket), + login:logout(ID), + {atomic, ok} = db:delete(player, ID), + ok. + +%%% Test visitor functionality + +test135() -> + ok. + +%%% Login and logout using a network server + +test140() -> + Host = localhost, + Port = 10000, + db:delete(player), + db:delete(game_xref), + {ok, Server} = server:start(Host, Port), + timer:sleep(3000), + %% create dummy players + Nick = "test14-1", + {atomic, ID} = player:create(Nick, "foo", "", 1000), + {ok, Socket} = tcp_server:start_client(Host, Port, 1024), + ?tcpsend(Socket, {?PP_LOGIN, Nick, "@#%^@#"}), + ?match(success, ?waittcp({?PP_BAD, ?PP_LOGIN, ?ERR_BAD_LOGIN}, 2000)), + ?tcpsend(Socket, {?PP_LOGIN, Nick, "foo"}), + ?match(success, ?waittcp({?PP_PID, ID}, 2000)), + %% disconnect without logging out + gen_tcp:close(Socket), + %% login again + {ok, Socket1} = tcp_server:start_client(Host, Port, 1024), + ?tcpsend(Socket1, {?PP_LOGIN, Nick, "foo"}), + ?match(success, ?waittcp({?PP_PID, ID}, 2000)), + ?tcpsend(Socket1, ?PP_LOGOUT), + ?match(success, ?waittcp({?PP_GOOD, ?PP_LOGOUT, 0}, 2000)), + gen_tcp:close(Socket1), + %% clean up + {atomic, ok} = db:delete(player, ID), + server:stop(Server), + ok. + +%%% Find a game + +test150() -> + Host = localhost, + Port = 10000, + db:delete(game_xref), + {ok, Server} = server:start(Host, Port), + timer:sleep(3000), + %% find an empty game + find_game(Host, Port), + %% clean up + server:stop(Server), + ok. + +%%% Run through a simple game scenario + +test160() -> + Host = "localhost", + Port = 10000, + db:delete(player), + db:delete(game_xref), + {ok, Server} = server:start(Host, Port), + timer:sleep(2000), + %% find an empty game + GID = find_game(Host, Port), + %% create dummy players + Data + = [{ID2, _}, {ID1, _}, _] + = setup_game(Host, Port, GID, + [{"test160-bot1", 1, ['BLIND', 'FOLD']}, + {"test160-bot2", 2, ['BLIND']}]), + %% make sure game is started + ?match(success, ?waitmsg({'START', GID}, ?START_DELAY * 2)), + %% check balances + ?match({atomic, 0.0}, db:get(player, ID1, balance)), + ?match({atomic, 1000.0}, db:get(player, ID1, inplay)), + ?match({atomic, 0.0}, db:get(player, ID2, balance)), + ?match({atomic, 1000.0}, db:get(player, ID2, inplay)), + %% wait for game to end + Winners = gb_trees:insert(2, 15.0, gb_trees:empty()), + ?match(success, ?waitmsg({'END', GID, Winners}, ?PLAYER_TIMEOUT)), + timer:sleep(1000), + %% check balances again + ?match({atomic, 995.0}, db:get(player, ID1, balance)), + ?match({atomic, 0.0}, db:get(player, ID1, inplay)), + ?match({atomic, 1005.0}, db:get(player, ID2, balance)), + ?match({atomic, 0.0}, db:get(player, ID2, inplay)), + %% clean up + cleanup_game(Data), + server:stop(Server), + ok. + +%%% Start game dynamically + +test170() -> + Host = localhost, + Port = 10000, + db:delete(player), + db:delete(game_xref), + {ok, Server} = server:start(Host, Port), + timer:sleep(3000), + %% create dummy players + Nick = pid_to_list(self()), + {atomic, ID} = player:create(Nick, "foo", "", 1000), + {ok, Socket} = tcp_server:start_client(Host, Port, 1024), + ?tcpsend(Socket, {?PP_LOGIN, Nick, "foo"}), + ?match(success, ?waittcp({?PP_PID, ID}, 2000)), + Packet = {?PP_NEW_GAME_REQ, ?GT_IRC_TEXAS, 1, + {?LT_FIXED_LIMIT, 10, 20}}, + %% save flag + {atomic, DynamicGames} = db:get(cluster_config, 0, enable_dynamic_games), + %% disable dynamic games + {atomic, ok} = db:set(cluster_config, 0, + {enable_dynamic_games, false}), + ?tcpsend(Socket, Packet), + ?match(success, ?waittcp({?PP_BAD, ?PP_NEW_GAME_REQ, + ?ERR_START_DISABLED}, 2000)), + %% enable dynamic games + {atomic, ok} = db:set(cluster_config, 0, + {enable_dynamic_games, true}), + ?tcpsend(Socket, Packet), + GID = receive + {tcp, _, Bin1} -> + case proto:read(Bin1) of + {?PP_GOOD, ?PP_NEW_GAME_REQ, Temp} -> + Temp + end; + Temp1 -> + ?match(0, Temp1) + after 2000 -> + ?match(0, timeout) + end, + %% make sure it's our game + ?tcpsend(Socket, {?PP_SEAT_QUERY, GID}), + ?match(success, ?waittcp({?PP_SEAT_STATE, GID, 1, ?PS_EMPTY, 0}, 2000)), + %% clean up + gen_tcp:close(Socket), + {atomic, ok} = db:set(cluster_config, 0, + {enable_dynamic_games, DynamicGames}), + {atomic, ok} = db:delete(player, ID), + server:stop(Server), + ok. + +%%% Query own balance + +test180() -> + Host = localhost, + Port = 10000, + db:delete(player), + db:delete(game_xref), + {ok, Server} = server:start(Host, Port), + timer:sleep(3000), + Nick = pid_to_list(self()), + {atomic, ID} = player:create(Nick, "foo", "", 1000.0), + {ok, Socket} = tcp_server:start_client(Host, Port, 1024), + ?tcpsend(Socket, {?PP_LOGIN, Nick, "foo"}), + ?match(success, ?waittcp({?PP_PID, ID}, 2000)), + %% balance check + ?tcpsend(Socket, ?PP_BALANCE_REQ), + ?match(success, ?waittcp({?PP_BALANCE_INFO, 1000.0, 0.0}, 2000)), + ?match({atomic, 1000.0}, db:get(player, ID, balance)), + ?match({atomic, 0.0}, db:get(player, ID, inplay)), + %% move some money + ?match({atomic, ok}, db:move_amt(player, ID, {balance, inplay, 150})), + %% another balance check + ?tcpsend(Socket, ?PP_BALANCE_REQ), + ?match(success, ?waittcp({?PP_BALANCE_INFO, 850.0, 150.0}, 2000)), + ?match({atomic, 850.0}, db:get(player, ID, balance)), + ?match({atomic, 150.0}, db:get(player, ID, inplay)), + %% clean up + gen_tcp:close(Socket), + {atomic, ok} = db:delete(player, ID), + server:stop(Server), + ok. + +%%% Create players from the irc poker database +%%% and login/logout all of them. + +test190() -> + Host = localhost, + Port = 10000, + db:delete(player), + db:delete(game_xref), + multibot:create_players(), + {ok, Server} = server:start(Host, Port), + timer:sleep(3000), + {atomic, Players} = db:find(player), + test190(Host, Port, Players), + server:stop(Server), + ok. + +test190(_Host, _Port, []) -> + ok; + +test190(Host, Port, [Player|Rest]) + when is_record(Player, player) -> + Nick = Player#player.nick, + ID = Player#player.oid, + {ok, Socket} = tcp_server:start_client(Host, Port, 1024), + ?tcpsend(Socket, {?PP_LOGIN, Nick, "foo"}), + ?match(success, ?waittcp({?PP_PID, ID}, 2000)), + ?tcpsend(Socket, ?PP_LOGOUT), + ?match(success, ?waittcp({?PP_GOOD, ?PP_LOGOUT, 0}, 2000)), + gen_tcp:close(Socket), + test190(Host, Port, Rest). + +%%% Populate a dummy game to test the client + +dummy_game() -> + Host = "localhost", + Port = 2000, + %% find an empty game + GID = find_game(Host, Port, ?GT_TEXAS_HOLDEM), + %% create dummy players + setup_game(Host, Port, GID, + [{"test14-bot1", 1, ['SIT OUT']}, + {"test14-bot2", 2, ['SIT OUT']}, + {"test14-bot3", 3, ['SIT OUT']}, + {"test14-bot4", 4, ['SIT OUT']}]), + GID. + +%%% +%%% Utility +%%% + +kill_players([]) -> + ok; + +kill_players([{Player, _}|Rest]) -> + ID = gen_server:call(Player, 'ID'), + player:stop(Player), + {atomic, ok} = db:delete(player, ID), + kill_players(Rest). + +make_player(Nick) + when is_atom(Nick) -> + make_player(atom_to_list(Nick)); + +make_player(Nick) + when is_list(Nick) -> + {atomic, _ID} = player:create(Nick, "foo", "", 1000), + {ok, Pid} = player:start(Nick), + Pid. + +make_players(0, Acc) -> + Acc; + +make_players(N, Acc) -> + Nick = pid_to_list(self()) ++ " - " ++ integer_to_list(N), + Pid = make_player(Nick), + make_players(N - 1, [{Pid, N}|Acc]). + +make_players(N) -> + make_players(N, []). + +make_test_game(Players, Context, Modules) -> + make_test_game(length(Players), Players, Context, Modules). + +make_test_game(SeatCount, Players, Context, Modules) -> + {ok, Game} = cardgame:test_start(?GT_IRC_TEXAS, + SeatCount, + {?LT_FIXED_LIMIT, 10, 20}, + Context, + Modules), + cardgame:cast(Game, {'TIMEOUT', 3000}), + join_game(Game, Players), + Game. + +make_game(Players) -> + make_game(length(Players), Players). + +make_game(SeatCount, Players) -> + {ok, Game} = cardgame:start(?GT_IRC_TEXAS, + SeatCount, + {?LT_FIXED_LIMIT, 10, 20}), + join_game(Game, Players), + Game. + +join_game(_Game, []) -> + ok; + +join_game(Game, [{Player, SeatNum}|Rest]) -> + cardgame:cast(Game, {?PP_JOIN, Player, SeatNum, 1000, ?PS_PLAY}), + join_game(Game, Rest). + +install_trigger(Fun, State, Pids) when is_list(Pids) -> + lists:foreach(fun({Pid, _}) -> + sys:install(Pid, {Fun, State}) + end, Pids); + +install_trigger(Fun, State, Pid) when is_pid(Pid) -> + sys:install(Pid, {Fun, State}). + +find_game(Host, Port) -> + find_game(Host, Port, ?GT_IRC_TEXAS). + +find_game(Host, Port, GameType) -> + {ok, Socket} = tcp_server:start_client(Host, Port, 1024), + ?tcpsend(Socket, {?PP_GAME_QUERY, + GameType, + ?LT_FIXED_LIMIT, + ?OP_IGNORE, 2, % required + ?OP_EQUAL, 0, % joined + ?OP_IGNORE, 0}), % waiting + GID = receive + {tcp, _, Bin} -> + case proto:read(Bin) of + {?PP_GAME_INFO, ID, GameType, + _Expected, _Joined, _Waiting, + {?LT_FIXED_LIMIT, _Low, _High}} -> + ID + end; + Any -> + io:format("Got: ~w~n", [Any]), + ?match(0, 1) + after 3000 -> + ?match(0, 1) + end, + ok = gen_tcp:close(Socket), + flush(), + GID. + +flush() -> + receive + _ -> + flush() + after 0 -> + ok + end. + +connect_observer(Host, Port, GID) -> + connect_observer(Host, Port, GID, false). + +connect_observer(Host, Port, GID, Trace) -> + {ok, Obs} = observer:start(self()), + gen_server:cast(Obs, {'TRACE', Trace}), + ok = gen_server:call(Obs, {'CONNECT', Host, Port}, 15000), + gen_server:cast(Obs, {?PP_WATCH, GID}), + {0, Obs}. + +connect_player(Nick, Host, Port, GID, SeatNum, Actions) -> + {atomic, ID} = player:create(Nick, "foo", "", 1000), + {ok, Bot} = bot:start(Nick, SeatNum, SeatNum, 1000), + gen_server:cast(Bot, {'SET ACTIONS', Actions}), + ok = gen_server:call(Bot, {'CONNECT', Host, Port}, 15000), + gen_server:cast(Bot, {?PP_LOGIN, Nick, "foo"}), + gen_server:cast(Bot, {?PP_WATCH, GID}), + {ID, Bot}. + +setup_game(Host, Port, GID, Bots) + when is_list(Host), + is_number(Port), + is_number(GID), + is_list(Bots) -> + X = connect_observer(Host, Port, GID, true), + setup_game(Host, Port, GID, Bots, [X]); + +setup_game(_Host, _Port, _GID, []) -> + []. + +setup_game(Host, Port, GID, [{Nick, SeatNum, Actions}|Rest], Cleanup) + when is_list(Host), + is_number(Port), + is_number(GID), + is_list(Nick), + is_number(SeatNum), + is_list(Actions), + is_list(Cleanup) -> + X = connect_player(Nick, Host, Port, GID, SeatNum, Actions), + setup_game(Host, Port, GID, Rest, [X|Cleanup]); + +setup_game(_Host, _Port, _GID, [], Cleanup) -> + Cleanup. + +cleanup_game([]) -> + ok; + +cleanup_game([{0, _}|Rest]) -> + cleanup_game(Rest); + +cleanup_game([{ID, Player}|Rest]) -> + gen_server:cast(Player, stop), + {atomic, ok} = db:delete(player, ID), + cleanup_game(Rest). + diff --git a/openpoker-server/src/test.hrl b/openpoker-server/src/test.hrl new file mode 100644 index 0000000..7465a14 --- /dev/null +++ b/openpoker-server/src/test.hrl @@ -0,0 +1,119 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-define(error1(Expr, Expected, Actual), + io:format("~s is ~w instead of ~w at ~w:~w~n", + [??Expr, Actual, Expected, ?MODULE, ?LINE])). + +-define(error2(Message), + io:format("~s at ~w:~w~n", + [Message, ?MODULE, ?LINE])). + +-define(match(Expected, Expr), + fun() -> + Actual = (catch (Expr)), + case Actual of + Expected -> + {success, Actual}; + _ -> + ?error1(Expr, Expected, Actual), + erlang:error("match failed", Actual) + end + end()). + +-define(differ(Expected, Expr), + fun() -> + Actual = (catch (Expr)), + case Actual of + Expected -> + ?error1(Expr, Expected, Actual), + erlang:error("differ failed", Actual); + _ -> + {success, Actual} + end + end()). + +-define(waitmsg(Message, Timeout), + fun() -> + receive + Message -> + success; + Other -> + {error, Other} + after Timeout -> + {error, timeout} + end + end()). + +-define(waitexit(Pid, Timeout), + fun() -> + receive + {'CARDGAME EXIT', Pid, Data} -> + {success, Data}; + Other -> + {error, Other} + after Timeout -> + {error, timeout} + end + end()). + + +-define(waittcp(Message, Timeout), + fun() -> + receive + {tcp, _, Bin} -> + case proto:read(Bin) of + Message -> + success; + Any -> + {error, Any} + end; + Other -> + {error, Other} + after Timeout -> + {error, timeout} + end + end()). + +-define(tcpsend(Socket, Data), + fun() -> + XXX = proto:write(Data), + case gen_tcp:send(Socket, XXX) of + ok -> + ok; + {error, closed} -> + ok; + {error,econnaborted} -> + ok; + Any -> + error_logger:error_report([ + {message, "gen_tcp:send error"}, + {module, ?MODULE}, + {line, ?LINE}, + {socket, Socket}, + {port_info, erlang:port_info(Socket, connected)}, + {data, Data}, + {bin, XXX}, + {error, Any}]) + end + end()). + + diff --git a/openpoker-server/src/texas.hrl b/openpoker-server/src/texas.hrl new file mode 100644 index 0000000..5b07d4d --- /dev/null +++ b/openpoker-server/src/texas.hrl @@ -0,0 +1,31 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +%% do not change field order! + +-record(texas, { + button_seat = none, + call = 0, + winners = none, + %% texas hold'em + small_blind_seat = none, + big_blind_seat = none + }). diff --git a/openpoker-server/src/util.erl b/openpoker-server/src/util.erl new file mode 100644 index 0000000..6b79355 --- /dev/null +++ b/openpoker-server/src/util.erl @@ -0,0 +1,31 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(util). + +-export([is_process_alive/1]). + +is_process_alive(Pid) + when is_pid(Pid) -> + rpc:call(node(Pid), erlang, is_process_alive, [Pid]). + + + diff --git a/openpoker-server/src/visitor.erl b/openpoker-server/src/visitor.erl new file mode 100644 index 0000000..89fb9c1 --- /dev/null +++ b/openpoker-server/src/visitor.erl @@ -0,0 +1,185 @@ +%%% Copyright (C) 2005 Wager Labs, SA +%%% +%%% This file is part of OpenPoker. +%%% +%%% OpenPoker is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public +%%% License as published by the Free Software Foundation; either +%%% version 2 of the License, or (at your option) any later version. +%%% +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +%%% General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public +%%% License along with this library; if not, write to the Free Software +%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +%%% +%%% Please visit http://wagerlabs.com or contact Joel Reymont +%%% at joelr@well.com for more information. + +-module(visitor). +-behaviour(gen_server). + +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, terminate/2, code_change/3]). +-export([start/0, stop/1, test/0]). + +-include("test.hrl"). +-include("common.hrl"). +-include("proto.hrl"). +-include("schema.hrl"). + +-record(data, { + socket = none + }). + +new() -> + #data { + }. + +start() -> + gen_server:start(visitor, [], []). + +init([]) -> + process_flag(trap_exit, true), + {ok, new()}. + +stop(Visitor) + when is_pid(Visitor) -> + gen_server:cast(Visitor, stop). + +terminate(_Reason, _Data) -> + ok. + +handle_cast('LOGOUT', Data) -> + {noreply, Data}; + +handle_cast('DISCONNECT', Data) -> + {stop, normal, Data}; + +handle_cast({'SOCKET', Socket}, Data) + when is_pid(Socket) -> + Data1 = Data#data { + socket = Socket + }, + {noreply, Data1}; + +handle_cast({'INPLAY-', _Amount}, Data) -> + {noreply, Data}; + +handle_cast({'INPLAY+', _Amount}, Data) -> + {noreply, Data}; + +handle_cast({?PP_WATCH, Game}, Data) + when is_pid(Game) -> + cardgame:cast(Game, {?PP_WATCH, self()}), + {noreply, Data}; + +handle_cast({?PP_UNWATCH, Game}, Data) + when is_pid(Game) -> + cardgame:cast(Game, {?PP_UNWATCH, self()}), + {noreply, Data}; + +handle_cast({Event, _Game, _Amount}, Data) + when Event == ?PP_CALL; + Event == ?PP_RAISE -> + {noreply, Data}; + +handle_cast({?PP_JOIN, _Game, _SeatNum, _BuyIn}, Data) -> + {noreply, Data}; + +handle_cast({?PP_LEAVE, _Game}, Data) -> + {noreply, Data}; + +handle_cast({Event, _Game}, Data) + when Event == ?PP_FOLD; + Event == ?PP_SIT_OUT; + Event == ?PP_COME_BACK -> + {noreply, Data}; + +handle_cast({?PP_CHAT, _Game, _Message}, Data) -> + {noreply, Data}; + +handle_cast({?PP_SEAT_QUERY, Game}, Data) -> + GID = cardgame:call(Game, 'ID'), + L = cardgame:call(Game, 'SEAT QUERY'), + F = fun({SeatNum, State, Player}) -> + PID = if + State /= ?SS_EMPTY -> + gen_server:call(Player, 'ID'); + true -> + 0 + end, + handle_cast({?PP_SEAT_STATE, GID, SeatNum, State, PID}, Data) + end, + lists:foreach(F, L), + {noreply, Data}; + +handle_cast({?PP_PLAYER_INFO_REQ, PID}, Data) -> + case db:find(player, PID) of + {atomic, [Player]} -> + handle_cast({?PP_PLAYER_INFO, + Player#player.pid, + Player#player.inplay, + Player#player.nick, + Player#player.location}, Data); + _ -> + oops + end, + {noreply, Data}; + +handle_cast({?PP_NEW_GAME_REQ, _GameType, _Expected, _Limit}, Data) -> + {noreply, Data}; + +handle_cast(stop, Data) -> + {stop, normal, Data}; + +handle_cast(Event, Data) -> + if + Data#data.socket /= none -> + Data#data.socket ! {packet, Event}; + true -> + ok + end, + {noreply, Data}. + +handle_call('ID', _From, Data) -> + {reply, 0, Data}; + +handle_call('INPLAY', _From, Data) -> + {reply, 0, Data}; + +handle_call(Event, From, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Event}, + {from, From}]), + {noreply, Data}. + +handle_info({'EXIT', _Pid, _Reason}, Data) -> + %% child exit? + {noreply, Data}; + +handle_info(Info, Data) -> + error_logger:info_report([{module, ?MODULE}, + {line, ?LINE}, + {self, self()}, + {message, Info}]), + {noreply, Data}. + +code_change(_OldVsn, Data, _Extra) -> + {ok, Data}. + +%%% +%%% Test suite +%%% + +test() -> + ok. + + + +