/cards or $cards
Posted by squirk
Sunday, December 31, 2006
Description: A random card generator until the specified hand is obtained.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; /cards : This is just a snippet to return how many randomly generated poker hands it will take to retrieve the specified hand.
; --->  Credit to hixxy and his /rarity snippet for the idea, i just wanted to make one of my own.
;
; This snippet can be used in two ways, either $cards(hand) or /cards hand
; ---> Hands include: Royal flush, Straight flush, Straight, Four a kind, Three of a kind, Full house, Two pair, One pair
; ---> When you use /cards, a window with an editbox is opened to display the information. You may input hands in the editbox to initiate the snippet again.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

alias cards {
  if (!$istok(royal flush.straight flush.flush.straight.four of a kind.three of a kind.two pair.one pair.full house,$1-,46)) $iif($isid,return invalid hand,echo $color(info) * /cards: Invalid hand.)
  else {
    var %` = $ticks, %>, %., %rf, %sf, %f, %s, %4, %3, %2p, %1p, %fh, %!
    :r
    var %x = 0, %c
    while (%x < 5) {
      inc %x
      :c
      %> = $r(1,13) $+ $replace($r(1,4),1,d,2,s,3,h,4,c)
      if (!$istok(%c,%>,32)) %c = %c %>
      else goto c
    }
    %> = $hand(%c)
    inc %.
    if ($istok(%>,$cn($1-).rev,32)) {
      var %x = 1, %h = rf sf 4 fh f s 3 2p 1p, %~ = $+($chr(40),$iif($calc($ticks - %`) < 1000,$v1 $+ ms,$round($calc($v1 /1000),0) $+ s),$chr(41)), %hand = $regsubex($replace(%c,11,J,12,Q,13,K),/1(d|h|s|c)/g,A1), %-
      if (!$isid) {
        if (!$window(@cards)) window -ae @cards
        aline @cards It took a total of[^B] %. [^B] $+ %~ hand $+ $iif(%. > 1,s) to get a[^K]2 $1- [^K]99with a hand of:[^K]4 %hand $+ [^K]99. $iif(%!,Other hands included:)
      }
      while ($gettok(%h,%x,32)) {
        var %' = $v1
        if (% [ $+ [ %' ] ]) {
          var %* = $v1, %" = $+(: %* $chr(40),$round($calc((%* / %.) * 100),2),$chr(37),$chr(41))
          %- = $+(%-,$iif(%-,$chr(44)) $cn(%'),%")
          if (!$isid) aline @cards --> $ca($cn(%')) $+ %"
        }
        inc %x
      }
      if ($isid) return it took %. %~ hand $+ $iif(%. > 1,s) to get a[^B] $1- $+ [^B] $+ $iif(%-,$chr(44) other hands included: $+([,%-,]))
    }
    else {
      if ($gettok(%>,1,32)) {
        inc % [ $+ [ $v1 ] ]
        inc %!
      }
      goto r
    }
  }
}
alias -l hand {
  var %: = $remove($1,d,s,h,c), %p, %t, %f, %;
  if ($regex($1,/(d+d)/g) == 5) || ($regex($1,/(d+s)/g) == 5) || ($regex($1,/(d+h)/g) == 5) || ($regex($1,/(d+c)/g) == 5) {
    if ($isorder(%:)) || ($isorder($reptok(%:,1,14,1,32))) return $iif($gettok($sorttok($reptok(%:,1,14,1,32),32,n),1,32) == 10,rf) sf f
    return f
  }
  if ($isorder(%:)) || ($isorder($reptok(%:,1,14,1,32))) return s
  while ($gettok(%:,1,32)) {
    var %^ = $v1, %y = $findtok(%:,%^,0,32)
    while ($findtok(%:,%^,1,32)) %: = $remtok(%:,%^,1,32)
    ; %; = $regsubex(%:,/ $+ $gettok(%:,1,32) $+ /g, )
    if (%y > 1) inc % [ $+ [ $replace(%y,2,p,3,t,4,f) ] ]
  }
  if (%f) return 4 3 1p
  if (%t) return $iif(%p,fh 3 2p,3)
  if (%p) return %p $+ p
}
alias -l isorder {
  var %: = $sorttok($1,32,n), %x = 0
  while (%x < 4) {
    inc %x
    if ($calc($replace($gettok(%:,$+(%x,-,$calc(%x +1)),32),$chr(32),$chr(45))) != -1) return $false
  }
  return $true
}
alias -l cn {
  if ($prop == rev) return $replacex($1,royal flush,rf,straight flush,sf,flush,f,full house,fh,straight,s,four of a kind,4,three of a kind,3,two pair,2p,one pair,1p,flush,f)
  return $replacex($1,rf,royal flush,sf,straight flush,fh,full house,s,straight,4,four of a kind,3,three of a kind,2p,two pair,1p,one pair,f,flush)
}
alias -l ca return $upper($left($1-,1)) $+ $right($1-,-1)
on *:input:@cards: cards $1-


Open to suggestions if you have any.

Note: Just to give you a heads up, for certain unlikely hands like a straight flush and royal flush, your mirc will indeed freeze for maybe a long period of time, but it will eventually come back.  maybe whilefix.dll would fix it

edit: here's the version with whilefix.dll, you would need to download the dll itself and adjust the /dll command in the cards alias to the path to your dll.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; /cards : This is just a snippet to return how many randomly generated poker hands it will take to retrieve the specified hand.
; --->  Credit to hixxy and his /rarity snippet for the idea, i just wanted to make one of my own.
;
; This snippet can be used in two ways, either $cards(hand) or /cards hand
; ---> Hands include: Royal flush, Straight flush, Straight, Four a kind, Three of a kind, Full house, Two pair, One pair
; ---> When you use /cards, a window with an editbox is opened to display the information. You may input hands in the editbox to initiate the snippet again.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

alias cards {
  if (!$istok(royal flush.straight flush.flush.straight.four of a kind.three of a kind.two pair.one pair.full house,$1-,46)) $iif($isid,return invalid hand,echo $color(info) * /cards: Invalid hand.)
  else {
    var %` = $ticks, %>, %., %rf, %sf, %f, %s, %4, %3, %2p, %1p, %fh, %!, %::
    while (!%::) {
      dll <b>path/to/dll</b> WhileFix .
      var %x = 0, %c
      while (%x < 5) {
        inc %x
        :c
        %> = $r(1,13) $+ $replace($r(1,4),1,d,2,s,3,h,4,c)
        if (!$istok(%c,%>,32)) %c = %c %>
        else goto c
      }
      %> = $hand(%c)
      inc %.
      if ($istok(%>,$cn($1-).rev,32)) inc %::
      elseif ($gettok(%>,1,32)) {
        inc % [ $+ [ $v1 ] ]
        inc %!
      }
    }
    var %x = 1, %h = rf sf 4 fh f s 3 2p 1p, %~ = $+($chr(40),$iif($calc($ticks - %`) < 1000,$v1 $+ ms,$round($calc($v1 /1000),0) $+ s),$chr(41)), %hand = $regsubex($replace(%c,11,J,12,Q,13,K),/1(d|h|s|c)/g,A1), %-
    if (!$isid) {
      if (!$window(@cards)) window -ae @cards
      aline @cards It took a total of[^B] %. [^B] $+ %~ hand $+ $iif(%. > 1,s) to get a[^K]2 $1- [^K]99with a hand of:[^K]4 %hand $+ [^K]99. $iif(%!,Other hands included:)
    }
    while ($gettok(%h,%x,32)) {
      var %' = $v1
      if (% [ $+ [ %' ] ]) {
        var %* = $v1, %" = $+(: %* $chr(40),$round($calc((%* / %.) * 100),2),$chr(37),$chr(41))
        %- = $+(%-,$iif(%-,$chr(44)) $cn(%'),%")
        if (!$isid) aline @cards --> $ca($cn(%')) $+ %"
      }
      inc %x
    }
    if ($isid) return it took %. %~ hand $+ $iif(%. > 1,s) to get a[^B] $1- $+ [^B] $+ $iif(%-,$chr(44) other hands included: $+([,%-,]))
  }
}
alias -l hand {
  var %: = $remove($1,d,s,h,c), %p, %t, %f, %;
  if ($regex($1,/(d+d)/g) == 5) || ($regex($1,/(d+s)/g) == 5) || ($regex($1,/(d+h)/g) == 5) || ($regex($1,/(d+c)/g) == 5) {
    if ($isorder(%:)) || ($isorder($reptok(%:,1,14,1,32))) return $iif($gettok($sorttok($reptok(%:,1,14,1,32),32,n),1,32) == 10,rf) sf f
    return f
  }
  if ($isorder(%:)) || ($isorder($reptok(%:,1,14,1,32))) return s
  while ($gettok(%:,1,32)) {
    var %^ = $v1, %y = $findtok(%:,%^,0,32)
    while ($findtok(%:,%^,1,32)) %: = $remtok(%:,%^,1,32)
    ; %; = $regsubex(%:,/ $+ $gettok(%:,1,32) $+ /g, )
    if (%y > 1) inc % [ $+ [ $replace(%y,2,p,3,t,4,f) ] ]
  }
  if (%f) return 4 3 1p
  if (%t) return $iif(%p,fh 3 2p,3)
  if (%p) return %p $+ p
}
alias -l isorder {
  var %: = $sorttok($1,32,n), %x = 0
  while (%x < 4) {
    inc %x
    if ($calc($replace($gettok(%:,$+(%x,-,$calc(%x +1)),32),$chr(32),$chr(45))) != -1) return $false
  }
  return $true
}
alias -l cn {
  if ($prop == rev) return $replacex($1,royal flush,rf,straight flush,sf,flush,f,full house,fh,straight,s,four of a kind,4,three of a kind,3,two pair,2p,one pair,1p,flush,f)
  return $replacex($1,rf,royal flush,sf,straight flush,fh,full house,s,straight,4,four of a kind,3,three of a kind,2p,two pair,1p,one pair,f,flush)
}
alias -l ca return $upper($left($1-,1)) $+ $right($1-,-1)
on *:input:@cards: cards $1-
nice work
Posted by HellRaz0r
Monday, January 01, 2007 04:49pm PST
nice work, when your not busy can you upload a fixed version please.
hm?
Posted by squirk
Tuesday, January 02, 2007 02:56pm PST
in what way does it need fixing> do you mean with whilefix.dll? well i will but it wont be soon cuz im away for 2 weeks but i will when  get back
Submit a comment
Oops! You need to login or register before you can post a comment!

ebaum's world