flat assembler
Message board for the users of flat assembler.

flat assembler > Examples and Tutorials > Deluxe Video Poker

Author
Thread Post new topic Reply to topic
uart777



Joined: 17 Jan 2012
Posts: 369
New Video Poker for 1024x768x32 resolution. DirectX not required.

Image

Download: Video Poker

Source Preview:
Code:
N.DECK=52
N.CARDS=5

STRUCTURE CARD
 NUMBER n, suite, held, up
ENDS ?card

numeric WIN.ROYAL.FLUSH,\
 WIN.STRAIGHT.FLUSH, WIN.FOUR.KIND,\
 WIN.FULL.HOUSE, WIN.FLUSH, WIN.STRAIGHT,\
 WIN.THREE.KIND, WIN.TWO.PAIR, WIN.JACKS.BETTER

TEXTS wins[]=\
 'Royal Flush', 'Straight Flush',\
 'Four of a Kind', 'Full House', 'Flush',\
 'Straight', 'Three of a Kind', 'Two Pair',\
 'Jacks or Better'

; create hand and deck. 2-10=0-8, J-A=9-12.
; suites: 0=clubs, 1=spades, 2=hearts, 3=diamonds

function create.cards
locals p, i, n, suite
array.size hand, N.CARDS
.erase hand
array.size deck, N.DECK
let [i]=0
.loop [suite]=0 to 4       ; suites
  .loop [n]=0 to 13        ; numbers
    get [p]=.index deck[i]
    let [?card.n+eax]=[n],\
     [?card.suite+eax]=[suite],\
     [?card.up+eax]=NO,\
    [?card.held+eax]=NO, [i]++
  .endl
.endl
endf

macro shuffle.cards { array.randomize deck }

; copy next card from top of deck[n-1]
; to hand[i] then remove from deck

function deal.card, i
.if not [deck.n]       ; no cards remaining?
  create.cards         ; reload deck
  shuffle.cards
.end
array.recent deck      ; top card
array.replace \
 hand, [i], eax
array.reduce deck
.index hand[i]
let [?card.up+eax]=YES,\
 [?card.held+eax]=NO
endf

; deal cards from deck to hand. replace all
; hand cards that are not held with next
; cards in deck

function deal.cards
locals i
.loop [i]=0 to N.CARDS
  .index hand[i]
  .if not [?card.held+eax]
    deal.card [i]
  .end
.endl
endf

; search hand for card #. return # occurances

function has.card, c
locals i, nc
let [nc]=0
.loop [i]=0 to N.CARDS
  .index hand[i]
  let ecx=[?card.n+eax]
  .if [c]=ecx
    let [nc]++
  .end
.endl
endf [nc]

; all cards of the same suite?

function all.same.suite
locals i, suite
let eax=[hand.p],\ ; get first card suite
 [suite]=[?card.suite+eax]

; remaining cards must be same suite...

.loop [i]=1 to N.CARDS
  .index hand[i]
  let ecx=[?card.suite+eax]
  .if [suite]<>ecx
    return 0
  .end
.endl
endf 1

; jacks or better? pair of high cards: A/K/Q/J

function has.jacks.or.better
locals i, j, p, card.n
.loop [i]=0 to N.CARDS
  get [p]=.index hand[i]
  let [card.n]=[?card.n+eax]

  ; if high card, search remaining indices
  ; for same card #/.n...

  .if [card.n]>=CARD.JACK
    let eax=[i], eax++

    .loop [j]=eax to N.CARDS
      get [p]=.index hand[j]
      let ecx=[?card.n+eax]
      .if [card.n]=ecx
        return 1
      .end
    .endl
  .end
.endl
endf 0

; is there another card n?

function has.pair, n
locals i, nc
let [nc]=0
.loop [i]=0 to N.CARDS
  .index hand[i]
  let ecx=[?card.n+eax]
  .if [n]=ecx
    let [nc]++
    .if [nc]>1
      return 1
    .end
  .end
.endl
endf 0

; 2 pairs?

function has.two.pair
locals i, n, cn, np
let [cn]=NOTHING, [np]=0
.loop [i]=0 to N.CARDS
  .index hand[i]
  let eax=[?card.n+eax], [n]=eax
  .if [cn]<>eax
    .if.has.pair [n]
      let [cn]=[n], [np]++
      .if [np]>1
        return 1
      .end
    .end
  .end
.endl
endf 0

; has x of kind?

function has.x.kind, x
locals i
.loop [i]=0 to N.CARDS
  .index hand[i]
  has.card [?card.n+eax]
  .if eax=[x]
    return 1
  .end
.endl
endf 0

; full house? 3 of one kind, 2 of another

function has.full.house
.if.has.3.kind
  .if.has.2.kind
    return 1
  .end
.end
endf 0

; any five consecutive cards of same suite

function has.straight.flush
.if.has.straight
  .if.has.flush
    return 1
  .end
.end
endf 0

; royal flush? A/K/Q/J/10 of same suite

function has.royal.flush
.if.has.flush
  .if.has.card CARD.ACE
    .if.has.card CARD.KING
      .if.has.card CARD.QUEEN
        .if.has.card CARD.JACK
          .if.has.card CARD.10
            return 1
          .end
        .end
      .end
    .end
  .end
.end
endf 0

; is current hand a winner?

function winner?
.if.has.royal.flush
  return WIN.ROYAL.FLUSH
.end
.if.has.straight.flush
  return WIN.STRAIGHT.FLUSH
.end
.if.has.4.kind
  return WIN.FOUR.KIND
.end
.if.has.full.house
  return WIN.FULL.HOUSE
.end
.if.has.flush
  return WIN.FLUSH
.end
.if.has.straight
  return WIN.STRAIGHT
.end
.if.has.3.kind
  return WIN.THREE.KIND
.end
.if.has.two.pair
  return WIN.TWO.PAIR
.end
.if.has.jacks.or.better
  return WIN.JACKS.BETTER
.end
endf NOTHING

; calculate winnings

function payout
let eax=[win], eax*(5*4), ecx=[bet], ecx--,\
 ecx<<2, eax+ecx, eax=[payouts+eax],\
[won]=eax, eax+[bet], [credits]+eax
endf    

Do whatever you want with this: Copy, edit, distribute. More than likely, I will never show this to anyone else or do anything with it but give to the FASM community. Not something I'm proud of, just another little program, but the ideas and graphics may be useful to others.
Post 04 Jun 2013, 15:22
View user's profile Send private message Reply with quote
MHajduk



Joined: 30 Mar 2006
Posts: 6027
Location: Poland
At first I got a message of this kind: "Resolution must be XGA/1024x768x32". When I had changed default screen resolution to the expected one I was able to test your program. It works as expected. Smile

This piece of code
Code:
; royal flush? A/K/Q/J/10 of same suite 

function has.royal.flush 
.if.has.flush 
  .if.has.card CARD.ACE 
    .if.has.card CARD.KING 
      .if.has.card CARD.QUEEN 
        .if.has.card CARD.JACK 
          .if.has.card CARD.10 
            return 1 
          .end 
        .end 
      .end 
    .end 
  .end 
.end 
endf 0    
makes me wondering if it couldn't be done as a logical conjunction of the '.if.has.card x' operands - how do this code is translated to assembly exactly? Is it a chain of cmp's and conditional jumps?
Post 04 Jun 2013, 16:03
View user's profile Send private message Visit poster's website Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
Quote:
Is it a chain of cmp's and conditional jumps?
Yes, .if.has.card is a macro that calls has.card(#n) then ".if eax<>0". .if always translates to cmp-jxx, "if false, jmp to end". Relational AND/OR is not supported yet, but the logic is this: "ORs jmp to start if true, ANDs jmp to end if false". What LANGUAGE.INC really needs is type safety (variables with known type/size), improved error checking and easier structure/array access.

Quote:
It works as expected.
Well, there is a slight glitch when it deals but I'm not being paid to test+debug my programs so I can't dedicate much time to it.

Anyone trying to make a poker machine? I'll tell you what. Send me $5K and I'll have this working perfectly on any system. In US, $5K is just enough $ to buy a nice used car or build a small garage to live in.
Post 04 Jun 2013, 19:24
View user's profile Send private message Reply with quote
MHajduk



Joined: 30 Mar 2006
Posts: 6027
Location: Poland
uart777 wrote:
Anyone trying to make a poker machine? I'll tell you what. Send me $5K and I'll have this working perfectly on any system. In US, $5K is just enough $ to buy a nice used car or build a small garage to live in.
I can't pay you such an amount of money (to me it's also a big sum and can greatly improve my living level) but if I had, I would like to see you in the programmers team that may be created of the most creative members of this forum. I'm sure that FASM community has a great potential that, unfortunately, is wasted by envy and rivalry among the people here. We should make something with that. Yes, I know, I'm not free of those emotions too but I have begun understand that there exists a better way. We all can benefit from the cooperation, just need a "coordinator" that would have a general plan. Wink
Post 04 Jun 2013, 19:40
View user's profile Send private message Visit poster's website Reply with quote
typedef



Joined: 25 Jul 2010
Posts: 2913
Location: 0x77760000
Too much "glitter". Good work nonetheless. Shows someone was actually doing something.
Post 04 Jun 2013, 22:10
View user's profile Send private message Reply with quote
HaHaAnonymous



Joined: 02 Dec 2012
Posts: 1181
Location: Unknown
Stupid post removed.


Last edited by HaHaAnonymous on 28 Feb 2015, 20:13; edited 1 time in total
Post 05 Jun 2013, 00:46
View user's profile Send private message Reply with quote
Dex4u



Joined: 08 Feb 2005
Posts: 1601
Location: web
@uart777, this looks like its cut & pasted from a 3 year old Laughing
Post 05 Jun 2013, 18:48
View user's profile Send private message Reply with quote
typedef



Joined: 25 Jul 2010
Posts: 2913
Location: 0x77760000
Dex4u wrote:
@uart777, this looks like its cut & pasted from a 3 year old Laughing


lol. cut & paste sounds too rude. Maybe copy & paste.
Post 06 Jun 2013, 02:02
View user's profile Send private message Reply with quote
Display posts from previous:
Post new topic Reply to topic

Jump to:  


< Last Thread | Next Thread >
Forum Rules:
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum


Copyright © 1999-2019, Tomasz Grysztar.

Powered by rwasa.