VIDEOPOKER for KiXtart 2001

This script is dedicated to that elegant, beautiful lady we call KiXtart. Thanks for the years of faithfull service. And to your future - well - it couldn't be looking brighter !

DOWNLOAD INSTRUCTIONS

Edit this post by clicking on the the pencil and paper icon (lookie above). Then select the code from the editbox, cut it and paste it into notepad. Or if you would prefer, drop me an email and I'll mail it to you directly. My email address is shawn.tassie@cgi.ca

code:

---

break on cls
; ============
; KIXPOKER 1.3 
;   Shawn
; ============

;===
; REVISION HISTORY
; 
; 1.0 Initial version
; 1.1 Fixed UBB download problem and changed default card dimensions
; 1.2 Added JACKS_OR_BETTER and changed payout calculation
; 1.3 Added QUICK_DRAW and QUICK_DEAL 
;
;===

; ========
; SETTINGS
; ========
$QUICK_DEAL      = 0 ; Enable automatic re-deal
$QUICK_DRAW      = 0 ; Enable quicker drawing by disabling drop&flip
$JACKS_OR_BETTER = 0 ; Enable jacks or better mode 
; Choose a deck theme
$CARD_SIZE       = 10 ; 5-11
$CARD_FCOLOR     = "w"
$CARD_BCOLOR     = "r"
$CARD_BPATTERN   = "XXXXXXXXX"
; $CARD_BPATTERN   = " "
; $CARD_BPATTERN   = "double"
; $CARD_BPATTERN   = "single"
; $CARD_BPATTERN   = "KKKKKKKKK"
; $CARD_BPATTERN   = "#########"
$TABLE_FCOLOR    = "w+"
$TABLE_BCOLOR    = "g"
$SCREEN_FCOLOR   = "w+"
$SCREEN_BCOLOR   = "b"
$PLAYER_PURSE    = 1000
$TABLE_MINIMUM   = 10
srnd(1)
$seed = substr(@time,1,2)+substr(@time,4,2)+substr(@time,7,2)
$seed = val($seed)
srnd($seed)
$Screen = WindowInit()
$Table = Table($Screen) ; the one and only table
$Card1 = Card($Table,3,4)
$Card2 = Card($Table,17,4)
$Card3 = Card($Table,31,4)
$Card4 = Card($Table,45,4)
$Card5 = Card($Table,59,4)
$Count = 0,0,0,0,0,0,0,0,0,0,0,0,0,0
$Hand = $Card1,$Card2,$Card3,$Card4,$Card5
$Deck = Deck()
$= Welcome()
; =====
; POKER
; =====
do
 if $QUICK_DEAL=0
  get $key
 endif
 if asc($key) = 13
  DealerDealCards()
  do
   get $key
   if $key="1" or $key="2" or $key="3" or $key="4" or $key="5"
    $card = val($key)-1
    $Hand[$card] = PlayerToggleCard($Hand[$card])
   endif
   if asc($key) = 13
    DealerDrawCards()
    DealerEvaluateHand()
    $key = DealerPayTheManHisMoney()
    DealerResetCards()
   endif
  until $key="q" or asc($key) = 13
 endif
until $key="q"
$= SetColor("w+","n")
cls
exit
; ==========
; THE DEALER
; ==========
function DealerDealCards()
 $Deck = DeckShuffle($Deck)
 for $card=0 to ubound($Hand)
  $Hand[$card] = CardSetValue($Hand[$card],DeckDeal($Deck))
  if $QUICK_DRAW=0
   $Hand[$card] = CardPlaceDown($Hand[$card])
   $Hand[$card] = CardPickUp($Hand[$card])
  endif
  $Hand[$card] = CardFaceUp($Hand[$card])
  $Deck = DeckMoveNext($Deck)
 next
endfunction
function DealerDrawCards()
 for $card = 0 to ubound($Hand)
  if CardIsFaceUp($Hand[$card]) = 0
   $Hand[$card] = CardSetValue($Hand[$card],DeckDeal($Deck))
   if $QUICK_DRAW=0
    $Hand[$card] = CardPickUp($Hand[$card])
   endif
   $Hand[$card] = CardFaceUp($Hand[$card])
   $Deck = DeckMoveNext($Deck)
  endif
 next
endfunction
function DealerEvaluateHand()
 for $i = 1 to ubound($Count)
  $Count[$i] = 0
 next
 for $card = 0 to ubound($Hand)
  $value = CardGetValue($Hand[$card])
  $number = DeckValueToNumber($value)
  $Count[$number] = $Count[$number] + 1
 next
 select
  case HandIsRoyalFlush()
   $message = "A ROYAL FLUSH"
   $odds = 250
  case HandIsStraightFlush()
   $message = "A STRAIGHT FLUSH"
   $odds = 100
  case HandIsFourOfaKind()
   $message = "FOUR OF A KIND"
   $odds = 50
  case HandIsFullHouse()
   $message = "A FULL HOUSE"
   $odds = 20
  case HandIsFlush()
   $message = "A FLUSH"
   $odds = 11
  case HandIsStraight()
   $message = "A STRAIGHT"
   $odds = 5
  case HandIsThreeOfaKind()
   $message = "THREE OF A KIND"
   $odds = 3
  case HandIsTwoPair()
   $message = "TWO PAIR"
   $odds = 2
  case HandIsaPair()
   $message = "A PAIR"
   $odds = 1
  case 1
   $message = "NOTHING"
   $odds = 0
 endselect
endfunction
function DealerPayTheManHisMoney()
 $fcolor = "y+"
 $bcolor = $SCREEN_BCOLOR
 $score = WindowCreate($table,21,12,28,6,2,1,$fcolor,$bcolor)
 $score = WindowShow($score)
 $= SetColor("y+",$bcolor)
 $PLAYER_PURSE = $PLAYER_PURSE - $TABLE_MINIMUM
 $winnings = $TABLE_MINIMUM * $odds
 if $winnings
  $PLAYER_PURSE = $PLAYER_PURSE + $winnings
 endif
 at(14,25) "YOU HAVE " $message
 at(16,25) "DEALER PAYS " $winnings  " CREDITS"
 at(18,25) "YOU NOW HAVE " $PLAYER_PURSE " CREDITS"
 get $key
 if $key <> "q"
  $key = chr(13)
 endif
 $= SetColor("w+","n")
 $score = WindowHide($score)
 $DealerPayTheManHisMoney = $key
endfunction
function DealerResetCards()
 for $card=0 to ubound($Hand)
  $Hand[$card] = CardFaceDown($Hand[$card])
 next
endfunction
; ==========
; THE PLAYER
; ==========
function PlayerToggleCard($card)
 if CardIsFaceUp($card)
  $card = CardFaceDown($card)
  if $QUICK_DRAW=0
   $card = CardPlaceDown($card)
  endif
 else
  if $QUICK_DRAW=0
   $card = CardPickUp($card)
  endif
  $card = CardFaceUp($card)
 endif
 $PlayerToggleCard = $card
endfunction
; =========
; THE TABLE
; =========
function Table($parent)
 $window = WindowCreate($parent,2,1,75,21,1,1,$TABLE_FCOLOR,$TABLE_BCOLOR)
 $window = WindowShow($window)
 $Table = $window
endfunction
; ========
; THE HAND
; ========
function HandIsaPair()
 $HandIsPair = 0
 for $i = 1 to ubound($Count)
  if $Count[$i] = 2
   $HandIsaPair = 1
   if $JACKS_OR_BETTER and ($i < 11 and $i > 1)
    $HandIsaPair = 0
   endif
  endif
 next
endfunction
function HandIsTwoPair()
 $HandIsTwoPair = 0
 $found = 0
 for $i = 1 to ubound($Count)
  if $Count[$i] = 2
   if $found
    $HandIsTwoPair = 1
   else
    $found = 1
   endif
  endif
 next
endfunction
function HandIsThreeOfaKind()
 $HandIsThreeOfaKind = 0
 for $i = 1 to ubound($Count)
  if $Count[$i] = 3
   $HandIsThreeOfaKind = 1
  endif
 next
endfunction
function HandIsStraight()
 $HandIsStraight = 0
 $n = 0
 $ace = 0
 for $x = 1 to ubound($Count)
  if $Count[$x] = 1
   $n = $n + 1
   if $n = 1 and $x = 10 and $ace
    $n = $n + 1
   endif
   if $n = 5
    $x = ubound($Count)+1
   endif
  else
   if $n > 0 and $n < 5
    if $n = 1 and $x = 2
     $n = 0
     $ace = 1
    else
     $x = ubound($Count)+1
    endif
   endif
  endif
 next
 if $n = 5
  $HandIsStraight = 1
 endif
endfunction
function HandIsFlush()
 $HandIsFlush = 0
 $suite0 = CardGetSuite($Hand[0])
 $suite1 = CardGetSuite($Hand[1])
 $suite2 = CardGetSuite($Hand[2])
 $suite3 = CardGetSuite($Hand[3])
 $suite4 = CardGetSuite($Hand[4])
 if $suite1 = $suite0 and $suite2 = $suite0 
    and $suite3 = $suite0 and $suite4 = $suite0
  $HandIsFlush = 1
 endif
endfunction
function HandIsFullhouse()
 $HandIsFullHouse = 0
 if HandIsThreeOfaKind()
  for $i = 1 to ubound($Count)
   if $Count[$i] = 2
    $HandIsFullHouse = 1
   endif
  next
 endif
endfunction
function HandIsFourOfaKind()
 $HandIsFourOfaKind = 0
 for $i = 1 to ubound($Count)
  if $Count[$i] = 4
   $HandIsFourOfaKind = 1
  endif
 next
endfunction
function HandIsStraightFlush()
 $HandIsStraightFlush = 0
 if HandIsStraight()
  if HandIsFlush()
   $HandIsStraightFlush = 1
  endif
 endif
endfunction
function HandIsRoyalFlush()
 $HandIsRoyalFlush = 0
 if HandIsStraightFlush()
  if $Count[10] = 1 and $Count[1] = 1
   $HandIsRoyalFlush = 1
  endif
 endif
endfunction
; ========
; THE DECK
; ========
function Deck()
 $adeck = 1,0,0,0,0,0,0,0,0,0,0
 $Deck = $adeck
endfunction
function TestDeckShuffle($deck)
 $deck[0] = 1
 $deck[1] = 1
 $deck[2] = 10
 $deck[3] = 11
 $deck[4] = 12
 $deck[5] = 13
 $DeckShuffle = $deck
endfunction
function DeckShuffle($deck)
 for $i = 1 to ubound($deck)
  $deck[$i] = 0
  $found = 0
  do
   $value = rnd(51)+1
   $exists = 0
   for $j = 1 to $i
    if $deck[$j] = $value
     $exists = 1
    endif
   next
  until $exists = 0
  $deck[$i] = $value
 next
 $deck[0] = 1 ; next
 $DeckShuffle = $deck
endfunction
function DeckDeal($deck)
 $i = $deck[0]
 $DeckDeal = $deck[$i]
endfunction
function DeckMoveNext($deck)
 $deck[0] = $deck[0] + 1
 $DeckMoveNext = $deck
endfunction
function DeckValueToNumber($value)
 select
  case $value > 52
   cls ?"TRAP" quit(0)
  case $value > 39
   $value = $value - 39
  case $value > 26
   $value = $value - 26
  case $value > 13
   $value = $value - 13
 endselect
 $DeckValueToNumber = $value
endfunction
function DeckValueToSuite($value)
 select
  case $value > 39
   $value = 0
  case $value > 26
   $value = 1
  case $value > 13
   $value = 2
  case 1
   $value = 3
 endselect
 $DeckValueToSuite = $value
endfunction
; =========
; THE CARDS
; =========
function CardPickUp($card)
 $window = $card[0]
 $window = WindowHide($window)
 $window = WindowShadow($window)
 $window = WindowMove($window,-1,-1)
 $window = WindowShow($window)
 $card[0] = $window
 $card[4] = 1
 if CardIsFaceUp($card)
  $card = CardPaintFaceUp($card)
 else
  $card = CardPaintFaceDown($card)
 endif
 $CardPickUp = $card
endfunction
function CardPlaceDown($card)
 $window = $card[0]
 $window = WindowHide($window)
 $window = WindowUnShadow($window)
 $window = WindowMove($window,1,1)
 $window = WindowShow($window)
 $card[0] = $window
 $card[4] = 0
 if CardIsFaceUp($card)
  $card = CardPaintFaceUp($card)
 else
  $card = CardPaintFaceDown($card)
 endif
 $CardPlaceDown = $card
endfunction
function CardFaceUp($card)
 $window = $card[0]
 $window = WindowSetFColor($window,"n")
 $window = WindowSetBColor($window,"w+")
 $window = WindowSetStyle($window,0)
 $window = WindowShow($window)
 $card[0] = $window
 $card[5] = 1
 $card = CardPaintFaceUp($card)
 $CardFaceUp = $card
endfunction
function CardFaceDown($card)
 $window = $card[0]
 $window = WindowSetFColor($window,$CARD_FCOLOR)
 $window = WindowSetBColor($window,$CARD_BCOLOR)
 $window = WindowSetStyle($window,$CARD_BPATTERN)
 $window = WindowShow($window)
 $card[0] = $window
 $card[5] = 0
 $card = CardPaintFaceDown($card)
 $CardFaceDown = $card
endfunction
function CardPaintFaceUp($card)
 dim $suite
 $window = $card[0]
 $left = WindowGetLeft($window)
 $top = WindowGetTop($window)
 $width = WindowGetWidth($window)
 $height = WindowGetHeight($window)
 $number = $card[2]
 if $number > 10 or $number = 1
  $= SetColor("b","w+")
  box($top+1,$left+2,$top+$height-1,$left+$width-2,"single")
 endif
 select
  case $number = 1
   $number = "A"
  case $number = 11
   $number = "J"
  case $number = 12
   $number = "Q"
  case $number = 13
   $number = "K"
  case 1
   $number = "$number"
 endselect
 $suite = $card[3]
 if $suite = chr(3) or $suite = chr(4)
  $= SetColor("r","w+")
 else
  $= SetColor("n","w+")
 endif
 at($top+1,$left+1) "$number"
 at($top+2,$left+1) "$suite"
 if $number = 10
  at($top+$height-2,$left+$width-2) "$number"
 else
  at($top+$height-2,$left+$width-1) "$number"
 endif
 at($top+$height-1,$left+$width-1) "$suite"
 at(0,0)
 SetColor("w","n")
 $card[0] = $window
 $CardPaintFaceUp = $card
endfunction
function CardPaintFaceDown($card)
 $window = $card[0]
 $left = WindowGetLeft($window)
 $top = WindowGetTop($window)
 $width = WindowGetWidth($window)
 $height = WindowGetHeight($window)
 $window = WindowSetFColor($window,$CARD_FCOLOR)
 $= SetColor($window[6],$window[7])
 box($top,$left,$top+$height,$left+$width,$CARD_BPATTERN)
 $= SetColor("w","n")
 at(0,0)
 $card[0] = $window
 $CardPaintFaceDown = $card
endfunction
function CardSetValue($card,$value)
 $card[1] = $value
 $card[2] = DeckValueToNumber($value)
 $card[3] = chr(DeckValueToSuite($value)+3)
 $CardSetValue = $card
endfunction
function CardGetValue($card)
 $CardGetValue = $card[1]
endfunction
function CardGetSuite($card)
 $CardGetSuite = $card[3]
endfunction
function CardIsUp($card)
 $CardIsUp = $card[4] = 1
endfunction
function CardIsFaceUp($card)
 $CardIsFaceUp = $card[5] = 1
endfunction
function Card($parent,$left,$top)
 $card = 0,0,0,0,0,0,0,0
 $fcolor = $CARD_FCOLOR
 $bcolor = $CARD_BCOLOR
 $width = $CARD_SIZE
 $height = $CARD_SIZE
 $window = WindowCreate($parent,$left,$top,$width,$height,0,1,$fcolor,$bcolor)
 $card[0] = $window
 $card[1] = 1 ; value
 $card[2] = 0 ; tuple
 $card[3] = 0 ; suite
 $card[4] = 1 ; down/up
 $card[5] = 0 ; facedown/faceup
 $= WindowShow($window)
 $card = CardPaintFaceDown($card)
 $Card = $card
endfunction
; ===========
; THE WINDOWS
; ===========
function WindowInit()
 $window = 0,0,25,80,0,0
 $fcolor = $SCREEN_FCOLOR
 $bcolor = $SCREEN_BCOLOR
 $= SetColor($fcolor,$bcolor)
 cls
 $WindowInit=$window
endfunction
function WindowShow($window)
 if $window[5]
  $= SetColor("n","n")
  box($window[1]+1,$window[0]+1,$window[1]+$window[3]+1,$window[0]+$window[2]+1," ")
 endif
 $= SetColor($window[6],$window[7])
 $line=" "
 if $window[4]=1
  $line="single"
 else
  if $window[4]=2
   $line="double"
  endif
 endif
 box($window[1],$window[0],$window[1]+$window[3],$window[0]+$window[2],$line)
 $WindowShow = $window
endfunction
function WindowHide($window)
 $parent = $window[8]
 $bcolor = $parent[7]
 $shadow = $window[5]
 $= SetColor("n",$bcolor)
 box($window[1],$window[0],$window[1]+$window[3]+$shadow,$window[0]+$window[2]+$shadow," ")
 $WindowHide = $window
endfunction
function windowmove($window,$left,$top)
 $window[0] = $window[0] + $left
 $window[1] = $window[1] + $top
 $windowmove = $window
endfunction
function WindowCreate($parent,$left,$top,$width,$height,$style,$shadow,$fcolor,$bcolor)
 $window = 0,0,0,0,0,0,0,0,0
 $window[0] = $parent[0]+$left
 $window[1] = $parent[1]+$top
 $window[2] = $width
 $window[3] = $height
 $window[4] = $style
 $window[5] = $shadow
 $window[6] = $fcolor
 $window[7] = $bcolor
 $window[8] = $parent
 $WindowCreate = $window
endfunction
function WindowGetLeft($window)
 $WindowGetLeft = $window[0]
endfunction
function WindowGetTop($window)
 $WindowGetTop = $window[1]
endfunction
function WindowGetWidth($window)
 $WindowGetWidth = $window[2]
endfunction
function WindowGetHeight($window)
 $WindowGetHeight = $window[3]
endfunction
function WindowSetFColor($window,$color)
 $window[6] = $color
 $WindowSetFColor = $window
endfunction
function WindowSetBColor($window,$color)
 $window[7] = $color
 $WindowSetBColor = $window
endfunction
function WindowSetStyle($window,$style)
 $window[4] = $style
 $WindowSetStyle = $window
endfunction
function windowunshadow($window)
 $window[5] = 0
 $windowunshadow = $window
endfunction
function windowshadow($window)
 $window[5] = 1
 $windowshadow=$window
endfunction
; ==========
; THE OTHERS
; ==========
function Welcome()
$bcolor = $SCREEN_BCOLOR
$fcolor = "y+"
$welcome = WindowCreate($table,16,2,40,17,2,1,$fcolor,$bcolor)
$welcome = WindowShow($welcome)
$= SetColor("y+",$bcolor)
at(5,20) "              KIXPOKER"
$= SetColor($fcolor,$bcolor)
at(7,20) "       POWERED BY KIXTART 2001"
$= SetColor("w+",$bcolor)
at(10,20)"   DEAL/DRAW ......... PRESS ENTER"
at(11,20)"   DISCARD/RESTORE ... PRESS 1-5"
at(12,20)"   QUIT .............. PRESS Q"
$= SetColor($fcolor,$bcolor)
at(15,20)"  YOUR PURSE CONTAINS $PLAYER_PURSE CREDITS"
at(16,20)"    TABLE MINIMUM IS $TABLE_MINIMUM CREDITS"
$= SetColor("w+",$bcolor)
at(18,20)"     Press any key to continue..."
get $key
$Welcome = WindowHide($welcome)
for $card = 0 to ubound($Hand)
 $Hand[$card] = CardFaceDown($Hand[$card])
next
endfunction
function SetColor($fcolor,$bcolor)
 $color = "color "+"$fcolor"+"/"+"$bcolor"
 $= execute($color)
endfunction

---

st

[This message has been edited by Shawn (edited 27 April 2001).]

This is sooo cool.

And once we figure out how you did the graphics, KIX-games will never be the same again

You do have a little 'bug' in your code
the line:

code:

---

at(8,20) "           WWW.KIXTART.ORG" 

---

But after I fixed that, it works great!!

------------------
Greetz,

Roger the Young
------------------------
The code is out there...
------------------------

edited: STUPID UBB !!

[This message has been edited by DrillSergeant (edited 26 April 2001).]

after reading the code i lost the sense of the words function, endfunction

Jochen

_________________________

I wrote this script for a number of reasons:

1) The biggest reason was to try and write a kscript that used object-oriented design methodologies. Most everything in kixpoker is an "object" with state information contained in an array. Arrays are passed around (between functions) like a token is passed around in a token-ring network.

2) The other reason is that I wanted to test the feasibilty of creating a textwindow UDF library for KiXtart. The one that's in this script is only half finished. One still has to print text in absolute coordinates.

3) I wanted to excercise k so what better to do that with than with a large mega-function game script.

4) And lastly - because I was so impressed (actually "moved" might be a better word) by cj's Kix-Adventure and 3D Maze scripts - I couldn't help but want to toss my hat into the kix gaming ring and help evolve this technology !

Shawn.

[This message has been edited by Shawn (edited 26 April 2001).]

Totaly kick ass!!

Bryce

------------------
kix.isorg.net

If you don't mind, I would like to use your library for some more game ideas I have...

Keep up the good work!

cj

ceej:

Like to get your thoughts on random number generation [rnd() srnd()]. Have you (or anybody) figured out how this works. I'm thinking that what might be a good idea (for any game) is to reset the random number generator each time the you press enter. And does one have to use the srnd(1) (reset) function only - or in combination with srnd(aNumber) ?

The window UDF functions are yours for the taking - although they obviously still need a lot of work. The intent really was to stimulate ideas and discussion and maybe even get some group UDF library development started...

Shawn.

[This message has been edited by Shawn (edited 26 April 2001).]

Very neat design!

Speed it UP

When i saw the the way your script performed (nearly as a compiled application), i got curious, was it by design,
better performance of KiX2001 or because of a better performance of functions over subroutines.

I just re-aranged my logon-scrips, so all SubRoutines is replaced by Functions that returns nothing, so instead of:
Gosub ChkDives

I use:
$Err = ChkDives()
This wil do the job of SubRoutine ChkDrives, but it is a Function returning noting

This speeded my logon-script up to to double speed (Half time), so maybe Ruud has made some form of 'precompile'
for functions.

Regards
-Erik

Ps.
Shawn i stil think your dessign is neat, but should we make a request to Ruud for a:
SubName EndSub
Only difference from a UDF is no () and EndSub instead of EndFunction

Instead of:
GoSub Return

I havn't timed this 'feature', but try it out KiX-starters

[This message has been edited by kholm (edited 27 April 2001).]

Thanks - funny you should mention performance because I just added two new settings (and reposted the script) to speed things up a little:

QUICK_DRAW Enables faster screen drawing by disabling card drop & flip animation sequences. Did anybody notice that when your hand is dealt, the cards are dropped on the table one-by-one and then "flipped" over, then picked-up into view ? Anybody got any better ideas for a cooler (non-annoying) animation sequence ?

QUICK_DEAL Automatically redeals your hand after the payout box is displayed (no need to hit return twice)

Just manually make these setting changes in the script turn them on. And yes - I'm very pleased with the performance of KiXtart 2001 as well - especially considering all the overhead I introduced by using an object-oriented design approach. I think two things contribute to performance here ...

1) I tried to use the builtin BOX function as much as possible. This function packs a lot of low-level screen I/O power into a single KIX statement.

2) And you're right about the "pre-compile" for functions. Although "pre-scan" might be a better term. I remember Ruud mentioning (somewhere) that KiXtart now does a two pass scan through the memory resident script. The first pass scans for function names and caches pointers to them. The second one processes the script. Either that or he's caching the function pointers while loading the script. Do you know how things worked in the pre-2001 releases ?

Your desire to have function subroutines is already there. I tried it out a few days ago and it works great (although beta 1 always skipped the first command in UDF's without arguments - now fixed). This works in beta 2a...

code:

---

break on

ChkDrives

exit

function ChkDrives

 ?"Inside function CHKDRIVES..."

endfunction

---

st

[This message has been edited by Shawn (edited 27 April 2001).]