{{ Propeller Poker - Copyright 2009 Michael Kohn }} {{ http://www.mikekohn.net/ mike@mikekohn.net/ }} VAR byte deck[10] byte hold[5] byte card[5] ' Wasn't sure if i should make these local or global :( byte cards_int[5] byte cards_map[5] byte cards_int_low[5] byte cards_map_low[5] byte suits[4] byte pairs[2] word score byte bet Pub initialize score := 50 bet := 1 Pub shuffleCards | rand, count, r, bad_flag bytefill(@deck, -1, 10) repeat count from 0 to 9 repeat rand := CNT ?rand rand := (||rand) // 52 bad_flag := 0 repeat r from 0 to count if deck[r] == rand bad_flag := 1 if bad_flag == 0 quit deck[count] := rand repeat count from 0 to 4 hold[count] := 0 card[count] := deck[count] cards_int[count] := 0 Pub drawNumbers(bitmap_ptr, num) | count, cpos[4], pos, temp, y repeat temp from 0 to 3 cpos[temp] := num // 10 num := num / 10 if cpos[temp] < 2 cpos[temp] := cpos[temp] + 17 else cpos[temp]-- cpos[temp] := cpos[temp] << 3 pos := 0 repeat y from 0 to 7 temp := byte[@charset][cpos[3]+y] temp := temp | (byte[@charset][cpos[2]+y]<<8) temp := temp | (byte[@charset][cpos[1]+y]<<16) temp := temp | (byte[@charset][cpos[0]+y]<<24) long[bitmap_ptr][pos] := temp pos := pos + 16 Pub drawResult(colors_ptr, bitmap_ptr, cptr) | pos, y Word[colors_ptr][(9*16)+7] := %11110000_00000000 pos := 9*(16*32)+ 7 repeat y from 0 to 7 long[bitmap_ptr][pos+(y*16)] := long[cptr][y] Pub drawScore(colors_ptr, bitmap_ptr) Word[colors_ptr][16+4] := %00110000_00000000 drawNumbers(bitmap_ptr + (48*64)+(4*4), score) Pub drawBet(colors_ptr, bitmap_ptr) Word[colors_ptr][16+10] := %00110000_00000000 drawNumbers(bitmap_ptr + (48*64)+(10*4), bet) Pub changeBet bet++ if bet > 5 or bet > score bet := 1 Pub changeScore(colors_ptr, bitmap_ptr, payout) | Count if payout == 0 score := score - bet if bet > score bet :=score drawScore(colors_ptr, bitmap_ptr) drawBet(colors_ptr, bitmap_ptr) else repeat Count from 1 to (payout * bet) score++ WaitCnt(8_000_000 + Cnt) drawScore(colors_ptr, bitmap_ptr) Pub drawCards(colors_ptr, bitmap_ptr) | count, pos, y, cpos Word[colors_ptr][(9*16)+7] := %00000000_00000000 repeat count from 0 to 4 if card[count] // 4 < 2 word[colors_ptr][(5*16)+3+(count<<1)] := %11111100_11000000 word[colors_ptr][(6*16)+3+(count<<1)] := %11111100_11000000 else word[colors_ptr][(5*16)+3+(count<<1)] := %11111100_00000000 word[colors_ptr][(6*16)+3+(count<<1)] := %11111100_00000000 pos := (5*(16*32))+(3+(count<<1)) long[bitmap_ptr][pos] := $7fff_fffe pos := pos + 16 cpos := (card[count] >> 2) << 3 repeat y from 1 to 8 long[bitmap_ptr][pos] := (byte[@charset][cpos] << 2) ^ $ffff_ffff pos := pos + 16 cpos := cpos + 1 repeat y from 9 to 24 long[bitmap_ptr][pos] := $ffff_ffff pos := pos + 16 cpos := ((card[count] // 4) + 13) << 3 repeat y from 25 to 32 long[bitmap_ptr][pos] := (byte[@charset][cpos] << 13) ^ $ffff_ffff pos := pos + 16 cpos := cpos + 1 repeat y from 33 to 54 long[bitmap_ptr][pos] := $ffff_ffff pos := pos + 16 cpos := (card[count] >> 2) << 3 repeat y from 55 to 62 long[bitmap_ptr][pos] := (byte[@charset][cpos] << 22) ^ $ffff_ffff pos := pos + 16 cpos++ long[bitmap_ptr][pos] := $7fff_fffe pos := pos + 16 if cards_int[count] == 0 WaitCnt(20_000_000 + Cnt) Pub removeCards(colors_ptr, bitmap_ptr) | count repeat count from 0 to 4 if hold[count] == 0 word[colors_ptr][(5*16)+3+(count<<1)] := 0 word[colors_ptr][(6*16)+3+(count<<1)] := 0 WaitCnt(20_000_000 + Cnt) PRI sortHand | t, r, p repeat t from 0 to 4 cards_int[t] := card[t] / 4 cards_map[t] := t cards_int_low[t] := cards_int[t] cards_map_low[t] := t if cards_int[t] == 0 cards_int[t] := 13 repeat t from 0 to 3 repeat r from 4 to t+1 if cards_int[r-1] > cards_int[r] p := cards_int[r] cards_int[r] := cards_int[r-1] cards_int[r-1] := p p := cards_map[r] cards_map[r] := cards_map[r-1] cards_map[r-1] := p if cards_int_low[r-1] > cards_int_low[r] p := cards_int_low[r] cards_int_low[r] := cards_int_low[r-1] cards_int_low[r-1] := p p := cards_map_low[r] cards_map_low[r] := cards_map_low[r-1] cards_map_low[r-1] := p PUB suggest | t, r, p, s_flag ' converted this hunk of crap from Java s_flag := 0 sortHand ' Check for a Straight repeat t from 0 to 3 if cards_int[t] <> cards_int[t+1]-1 quit if t <> 4 if cards_int[0] == 1 and cards_int[3] == 4 and cards_int[4] == 13 t := 4 if t == 4 ' Definite Straight ByteFill(@hold, 1, 5) return ' Check for a Flush repeat t from 0 to 3 if card[t] // 4 <> card[t+1] // 4 quit if t == 4 ' Definate Flush ByteFill(@hold, 1, 5) return 'Mark any similar cards repeat t from 0 to 3 if cards_int[t] == cards_int[t+1] hold[cards_map[t]] := 1 hold[cards_map[t+1]] := 1 s_flag := 1 if s_flag == 1 return ' Check Almost Flush ByteFill(@suits, 0, 4) repeat t from 0 to 4 suits[card[t]//4]++ repeat t from 0 to 3 if suits[t] => 4 repeat r from 0 to 4 if card[r] // 4 == t hold[r] := 1 return if cards_int[4]-cards_int[1] == 4 or cards_int[4]-cards_int[1] == 3 repeat t from 1 to 4 hold[cards_map[t]] := 1 return if cards_int[3]-cards_int[0] == 4 or cards_int[3]-cards_int[0] == 3 repeat t from 0 to 3 hold[cards_map[t]] := 1 return if cards_int_low[4]-cards_int_low[1] == 4 or cards_int_low[4]-cards_int_low[1] == 3 repeat t from 1 to 4 hold[cards_map_low[t]] := 1 return if cards_int_low[3]-cards_int_low[0] == 4 or cards_int_low[3]-cards_int_low[0] == 3 repeat t from 0 to 3 hold[cards_map_low[t]] := 1 return ' Mark High Card if cards_int[4] > 9 hold[cards_map[4]] := 1 PUB checkHand(color_ptr, bitmap_ptr) | t, p, s, r sortHand repeat t from 0 to 3 if cards_int[t] <> cards_int[t+1]-1 quit if t <> 4 if cards_int[0] == 2 and cards_int[3] == 5 and cards_int[4] == 14 t := 4 if t == 4 repeat t from 0 to 3 if card[t]//4 <> card[t+1]//4 'winMessage="Straight"; drawResult(color_ptr, bitmap_ptr, @strt) changeScore(color_ptr, bitmap_ptr, 4) return if cards_int[0] == 10 'winMessage="Royal Flush"; drawResult(color_ptr, bitmap_ptr, @royal) changeScore(color_ptr, bitmap_ptr, 250) else 'winMessage="Straight Flush"; drawResult(color_ptr, bitmap_ptr, @str_fl) changeScore(color_ptr, bitmap_ptr, 50) repeat t from 0 to 3 if card[t]//4 <> card[t+1]//4 quit if t == 4 'winMessage="Flush"; drawResult(color_ptr, bitmap_ptr, @flush) changeScore(color_ptr, bitmap_ptr, 6) return p := 0 s := 0 r := 0 pairs[0] := 0 pairs[1] := 0 repeat t from 0 to 3 if s <> 0 and cards_int[t] <> s s := 0 p++ if cards_int[t] == cards_int[t+1] pairs[p]++ s := cards_int[t] r := s if s <> 0 p++ if p == 1 if pairs[0] == 1 and r => 10 'winMessage="Pair of Jacks or Better"; drawResult(color_ptr, bitmap_ptr, @jacks) changeScore(color_ptr, bitmap_ptr, 1) elseif pairs[0] == 2 'winMessage="Three Of A Kind"; drawResult(color_ptr, bitmap_ptr, @three) changeScore(color_ptr, bitmap_ptr, 3) elseif pairs[0] == 3 'winMessage="Four Of A Kind"; drawResult(color_ptr, bitmap_ptr, @four) changeScore(color_ptr, bitmap_ptr, 25) else 'winMessage="You Lose!"; drawResult(color_ptr, bitmap_ptr, @lose) elseif p == 2 if pairs[0] == 1 and pairs[1] == 1 'winMessage="Two Pair"; drawResult(color_ptr, bitmap_ptr, @pair) changeScore(color_ptr, bitmap_ptr, 2) else 'winMessage="Full House"; drawResult(color_ptr, bitmap_ptr, @full) changeScore(color_ptr, bitmap_ptr, 9) else 'winMessage="You Lose!"; drawResult(color_ptr, bitmap_ptr, @lose) PUB newDeal | t, r r := 5 repeat t from 0 to 4 cards_int[t] := hold[t] if hold[t] == 1 hold[t] := 0 else card[t] := deck[r] r++ PUB drawHolds(color_ptr, bitmap_ptr) | count, pos, y WordFill(color_ptr+(4*32), %11001100_00000000, 16) pos := (4*(16*32))+3+(16*20) repeat count from 0 to 4 if hold[count] == 1 repeat y from 0 to 7 long[bitmap_ptr][pos+(y*16)] := long[@hold_bt][y] else repeat y from 0 to 7 long[bitmap_ptr][pos+(y*16)] := 0 pos := pos + 2 PUB toggleHold(num) hold[num] := hold[num] ^ 1 PUB drawDecoration(color_ptr, bitmap_ptr)| y, pos WordFill(color_ptr+(0*32), %00001000_00000100, 16) WordFill(color_ptr+(11*32), %00001000_00000100, 16) LongFill(bitmap_ptr+(0*16*4), $ffffffff, 16*16) LongFill(bitmap_ptr+(367*16*4), $ffffffff, 16*16) Word[color_ptr][(1*16)+3] := %00100000_00000000 Word[color_ptr][(1*16)+9] := %00100000_00000000 pos := 1*(16*32) + (16*16) + 3 repeat y from 0 to 7 long[bitmap_ptr][pos+(y*16)] := long[@dollar][y] long[bitmap_ptr][pos+(y*16)+6] := long[@bet_txt][y] DAT charset BYTE 24, 60, 102, 195, 255, 195, 195, 195 BYTE 124, 195, 195, 96, 48, 24, 12, 255 BYTE 124, 195, 192, 120, 120, 192, 195, 124 BYTE 99, 99, 99, 99, 255, 96, 96, 96 BYTE 255, 3, 3, 3, 63, 192, 192, 127 BYTE 248, 14, 3, 63, 195, 195, 195, 60 BYTE 255, 192, 96, 96, 48, 48, 24, 12 BYTE 126, 195, 195, 62, 195, 195, 195, 60 BYTE 126, 195, 195, 195, 252, 192, 192, 126 BYTE 255, 24, 24, 24, 24, 24, 24, 24 BYTE 252, 96, 96, 96, 96, 96, 99, 62 BYTE 60, 102, 195, 195, 219, 243, 230, 188 BYTE 99, 51, 27, 15, 27, 51, 99, 195 BYTE 24, 60, 126, 255, 255, 126, 60, 24 BYTE 0, 102, 231, 255, 255, 126, 60, 24 BYTE 60, 60, 219, 255, 219, 24, 24, 24 BYTE 24, 60, 126, 255, 255, 219, 24, 24 BYTE 60, 102, 195, 195, 195, 195, 198, 60 BYTE 24, 28, 24, 24, 24, 24, 24, 60 hold_bt BYTE 195, 120, 12, 14 BYTE 195, 204, 12, 54 BYTE 195, 134, 13, 102 BYTE 195, 134, 13, 198 BYTE 255, 134, 13, 198 BYTE 195, 134, 13, 102 BYTE 195, 204, 12, 54 BYTE 195, 120, 252, 14 royal BYTE 31, 60, 134, 13 BYTE 99, 102, 204, 12 BYTE 99, 195, 120, 12 BYTE 99, 195, 48, 12 BYTE 31, 195, 48, 12 BYTE 51, 195, 48, 12 BYTE 99, 102, 48, 12 BYTE 99, 60, 48, 252 str_fl BYTE 124, 255, 6, 248 BYTE 6, 3, 6, 12 BYTE 6, 3, 6, 12 BYTE 6, 31, 6, 12 BYTE 60, 3, 6, 120 BYTE 96, 3, 6, 192 BYTE 96, 3, 6, 192 BYTE 62, 3, 254, 125 four BYTE 255, 120, 204, 126 BYTE 3, 204, 204, 198 BYTE 3, 134, 205, 198 BYTE 31, 134, 205, 62 BYTE 3, 134, 205, 102 BYTE 3, 134, 205, 198 BYTE 3, 204, 204, 198 BYTE 3, 120, 120, 198 full BYTE 255, 134, 13, 6 BYTE 3, 134, 13, 6 BYTE 3, 134, 13, 6 BYTE 31, 134, 13, 6 BYTE 3, 134, 13, 6 BYTE 3, 134, 13, 6 BYTE 3, 134, 13, 6 BYTE 3, 252, 252, 254 flush BYTE 255, 6, 248, 194 BYTE 3, 6, 12, 198 BYTE 3, 6, 12, 198 BYTE 31, 6, 12, 254 BYTE 3, 6, 120, 198 BYTE 3, 6, 192, 198 BYTE 3, 6, 192, 198 BYTE 3, 254, 125, 198 strt BYTE 124, 255, 254, 252 BYTE 6, 24, 134, 49 BYTE 6, 24, 134, 49 BYTE 6, 24, 198, 48 BYTE 60, 24, 62, 48 BYTE 96, 24, 102, 48 BYTE 96, 24, 198, 48 BYTE 62, 24, 134, 49 three BYTE 127, 195, 254, 252 BYTE 24, 195, 134, 5 BYTE 24, 195, 134, 5 BYTE 24, 255, 198, 60 BYTE 24, 195, 62, 4 BYTE 24, 195, 102, 4 BYTE 24, 195, 198, 4 BYTE 24, 195, 134, 253 pair BYTE 127, 195, 120, 124 BYTE 24, 195, 204, 204 BYTE 24, 195, 134, 205 BYTE 24, 219, 134, 125 BYTE 24, 219, 134, 13 BYTE 24, 219, 134, 13 BYTE 24, 126, 204, 12 BYTE 24, 102, 120, 12 jacks BYTE 31, 12, 0, 192 BYTE 48, 24, 0, 192 BYTE 48, 48, 0, 192 BYTE 24, 96, 254, 193 BYTE 12, 96, 0, 192 BYTE 6, 48, 254, 193 BYTE 3, 24, 0, 204 BYTE 127, 12, 0, 120 lose BYTE 3, 120, 248, 254 BYTE 3, 204, 12, 6 BYTE 3, 134, 13, 6 BYTE 3, 134, 113, 62 BYTE 3, 134, 193, 6 BYTE 3, 134, 193, 6 BYTE 3, 204, 192, 6 BYTE 255, 120, 124, 254 bet_txt BYTE 252, 248, 251, 3 BYTE 140, 25, 192, 48 BYTE 140, 25, 192, 48 BYTE 124, 120, 192, 0 BYTE 140, 25, 192, 48 BYTE 140, 25, 192, 48 BYTE 140, 25, 192, 0 BYTE 124, 248, 195, 0 dollar BYTE 0, 0, 128, 63 BYTE 0, 0, 96, 6 BYTE 0, 0, 96, 6 BYTE 0, 0, 128, 31 BYTE 0, 0, 0, 54 BYTE 0, 0, 0, 54 BYTE 0, 0, 0, 54 BYTE 0, 0, 192, 31